Computer Music 2004 January/Computer Music Magazine 68 2004.iso/pc/Software/PC Software/Demo Software/Actinic Audio Store/Audio.exe/CatalogInstaller.EXE/ACTINIC.pm

Perl POD Document | 2000-07-29 | 236.7 KB | 7,090 lines

#!perl
#**************************************************************************
#
# ACTINIC.pm    - module for common functions among the Actinic scripts
#
# Written by George Menyhert
#
# Copyright (c) Actinic Software Ltd 1998
#
#**************************************************************************

package ACTINIC;
require 5.002;

use Socket;
use strict;

#
# define some global constants
#
$::FALSE     = 0;                                            # return codes
$::TRUE         = 1;

$::FAILURE     = 0;
$::SUCCESS     = 1;
$::NOTFOUND = 2;
$::FAILEDSEARCH = $::NOTFOUND;                        # synonyms
$::EOF        = 3;
$::EOB         = 4;
$::BADDATA    = 5;
$::WARNING    = 6;
$::ACCEPTED    = 7;
$::REJECTED    = 8;
$::PENDING    = 9;

$::VARPREFIX     = 'NETQUOTEVAR:';                        # template variables
$::DELPREFIX     = 'NETQUOTEDEL:';                        # template delimiters

$::RBBYTE     = 0;                                        # enumeration of the field types
$::RBWORD     = 1;
$::RBDWORD    = 2;
$::RBQWORD    = 3;
$::RBSTRING   = 4;
$::RBKEY      = 5;

$::HIDDEN    = 0;                                            # the prompt status
$::OPTIONAL    = 1;
$::REQUIRED = 2;

$::PAYMENT_CREDIT_CARD                = 0;                # the various payment methods
$::PAYMENT_CASH_ON_DELIVERY        = 1;
$::PAYMENT_CHECK_ON_DELIVERY        = 2;
$::PAYMENT_INVOICE                    = 3;
$::PAYMENT_INVOICE_PRE_PAY            = 4;
$::PAYMENT_CREDIT_CARD_SEPARATE    = 5;

$::ORDER_AID_NONE            = 0;                            # the order aid methods
$::ORDER_AID_COMPLETE    = 1;
$::ORDER_AID_RESPOND        = 2;
$::ORDER_AID_CONTINUE    = 3;

$::LOCK_SH = 1;                                            # flock - share permissions
$::LOCK_EX = 2;                                            # flock - exclusive lock
$::LOCK_NB = 4;                                            # flock - non-blocking (can be or'ed with others)
$::LOCK_UN = 8;                                            # flock - unlock

$::g_sRequiredColor    = '#aa3333';                    # the "required" field color

$::g_sCancelButtonLabel = '';                            # the global button labels
$::g_sConfirmButtonLabel = '';
$::g_sAddToButtonLabel = '';
$::g_sEditButtonLabel = '';
$::g_sRemoveButtonLabel = '';
$::g_sSearchButtonLabel = '';

$::s_nErrorRecursionCounter = 0;

umask (0177);                                                # update the process umask

#
# define some ACTINIC package constants
#

$ACTINIC::prog_name = 'ACTINIC.pm';                    # Program Name
$ACTINIC::prog_name = $ACTINIC::prog_name;        # remove compiler warning
$ACTINIC::prog_ver = '$Revision: 216 $ ';                # program version
$ACTINIC::prog_ver = substr($ACTINIC::prog_ver, 11); # strip the revision information
$ACTINIC::prog_ver =~ s/ \$//;                        # and the trailers

$ACTINIC::BILLCONTACT     = "INVOICE";
$ACTINIC::SHIPCONTACT     = "DELIVERY";
$ACTINIC::SHIPINFO         = "SHIPPING";
$ACTINIC::TAXINFO         = "TAX";
$ACTINIC::GENERALINFO     = "GENERAL";
$ACTINIC::PAYMENTINFO     = "PAYMENT";
$ACTINIC::LOCATIONINFO     = "LOCATION";

$ACTINIC::FILE                = 0;
$ACTINIC::SDTOUT            = 1;
$ACTINIC::MEMORY            = 2;

$ACTINIC::s_bTraceSocket = $::FALSE;
$ACTINIC::s_bTraceSockFirstPass = $::TRUE;
$ACTINIC::s_bTraceFileFirstPass = $::TRUE;

$ACTINIC::ORDER_BLOB_MAGIC = hex('10');
$ACTINIC::ORDER_DETAIL_BLOB_MAGIC = hex("11");

$ACTINIC::FORM_URL_ENCODED             = 0;            # standard application/x-www-form-urlencoded (%xx) encoding
$ACTINIC::MODIFIED_FORM_URL_ENCODED    = 1;            # Actinic format - identical to eParameter except an
                                                                # underscore is used instead of a percent sign and the string is
                                                                # prepended with an "a"

$ACTINIC::B2B = new ACTINIC_B2B();                    # Create B2B object to keep B2B parameters
$ACTINIC::USESAFE = $::TRUE;                            # If true we attempt to use Safe.pm
$ACTINIC::USESAFEONLY = $::FALSE;                    # If true, eval is only allowed in Safe.pm

$ACTINIC::MAX_RETRY_COUNT      = 10;
$ACTINIC::RETRY_SLEEP_DURATION = 1;
$ACTINIC::DOS_SLEEP_DURATION = 2;

$ACTINIC::AssertIsActive = $::FALSE;                # true if an assert is being reported
$ACTINIC::AssertIsLooping = $::FALSE;                # true if the assert function appears to be stuck in a loop

#######################################################
#
# GetActinicDate - Get the current date in Actinic
#    format (GMT server time)
#
# Returns:     the date in YYYY/MM/DD HH:MM format
#
#######################################################

sub GetActinicDate
    {
    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    #
    # Get the current date/time on the server
    #
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $sDate);
    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime(time);    # platform independent time
    $mon++;                                                    # make month 1 based
    $year += 1900;                                            # make year AD based
    $sDate = sprintf("%4.4d/%2.2d/%2.2d %2.2d:%2.2d", $year, $mon, $mday, $hour, $min);
    #
    # Misc info
    #
    return($sDate);                                        # the date
    }

#######################################################
#
# InitMonthMap - initialize the month maps.  This
#    subroutine must be called after ReadPromptFile.
#
# Affects:     %::g_MonthMap (hash table mapping month names
#                    to their numbers
#                %::g_InverseMonthMap - hash table inversion
#                    of %::g_MonthMap
#
#######################################################

sub InitMonthMap
    {
    %::g_MonthMap = (GetPhrase(-1, 0), 1,            # hash to convert month to digit
                        GetPhrase(-1, 1), 2,
                        GetPhrase(-1, 2), 3,
                        GetPhrase(-1, 3), 4,
                        GetPhrase(-1, 4), 5,
                        GetPhrase(-1, 5), 6,
                        GetPhrase(-1, 6), 7,
                        GetPhrase(-1, 7), 8,
                        GetPhrase(-1, 8), 9,
                        GetPhrase(-1, 9), 10,
                        GetPhrase(-1, 10), 11,
                        GetPhrase(-1, 11), 12);
    my ($key, $value);
    while ( ($key, $value) = each %::g_MonthMap)    # build a revers map
        {
        $::g_InverseMonthMap{$value} = $key;
        }
    }

#######################################################
#
# GetCountryName - map the country code to country name
#
# Params:    0 - country code
#
# Returns:    0 - country name or undef on error
#
#######################################################

sub GetCountryName
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in CountryName ($#_)", __LINE__, __FILE__);
#? ACTINIC::ASSERT(defined $::g_pLocationList, "Location list undefined", __LINE__, __FILE__);
    my $sCode = $_[0];
    return ($$::g_pLocationList{$sCode});
    }

#######################################################
#
# GetHostname - attempt to retrieve the hostname
#
#    Returns:    0 - hostname or IP address or ''
#
#######################################################

sub GetHostname
    {
    my $sLocalhost = $ENV{SERVER_NAME};                # try the environment
    $sLocalhost =~ s/[^-a-zA-Z0-9.]//g;                # strip any bad characters

    if (!$sLocalhost)                                        # if still no hostname is found
        {
        $sLocalhost = $ENV{HOST};                        # try a different environment variable
        $sLocalhost =~ s/[^-a-zA-Z0-9.]//g;            # strip any bad characters
        }
    if (!$sLocalhost)                                        # if still no hostname is found
        {
        $sLocalhost = $ENV{HTTP_HOST};                # try a different environment variable
        $sLocalhost =~ s/[^-a-zA-Z0-9.]//g;            # strip any bad characters
        }
    if (!$sLocalhost)                                        # if still no hostname is found
        {
        $sLocalhost = $ENV{LOCALDOMAIN};                # try a different environment variable
        $sLocalhost =~ s/[^-a-zA-Z0-9.]//g;            # strip any bad characters
        }
    if (!$sLocalhost)                                        # if still no hostname is found
        {
        $sLocalhost = `hostname`;                        # try the command line
        $sLocalhost =~ s/[^-a-zA-Z0-9.]//g;            # strip any bad characters
        }
    if (!$sLocalhost &&                                    # if still no hostname and
         $^O eq 'MSWin32')                                # NT
        {
        my $sHost = `ipconfig`;                            # run ipconfig and gather the collection of addresses
        $sHost =~ /IP Address\D*([0-9.]*)/;            # get the first address in the list
        $sLocalhost = $1;
        $sLocalhost =~ s/[^-a-zA-Z0-9.]//g;            # strip any bad characters
        }

    return ($sLocalhost);
    }

#######################################################
#
# SendMail - Send an email to the specified email
#    address if this service has been requested.
#
#    Params:    0 - the smtp server ip address
#                1 - the destination email address
#                2 - the subject
#                3 - the message
#           4 - optional return address
#
#    Returns:    0 - status
#                1 - message
#
#######################################################

sub SendMail
    {
#? ACTINIC::ASSERT($#_ >= 3, "Invalid argument count in SendMail ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    if ($#_ < 3)
        {
        return($::FAILURE, GetPhrase(-1, 12, 'Actinic::SendMail'), 0, 0);
        }

    my ($sSmtpServer, $sEmailAddress, $sSubjectText, $sMessageText, $sReturnAddress) = @_;
    #
    # pass it on to the rich mail function
    #
    return(SendRichMail($sSmtpServer, $sEmailAddress, $sSubjectText, $sMessageText, "", $sReturnAddress));
    }

#######################################################
#
# SendRichMail - Send an email to the specified email
#    address if this service has been requested.
#
#    Params:    0 - the smtp server ip address
#                1 - the destination email address
#                2 - the subject
#                3 - the message as text
#                4 - the message as HTML
#           5 - optional return address
#
#    Returns:    0 - status
#                1 - message
#
#######################################################

sub SendRichMail
    {
#? ACTINIC::ASSERT($#_ >= 4, "Invalid argument count in SendRichMail ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    if ($#_ < 4)
        {
        return($::FAILURE, GetPhrase(-1, 12, 'Actinic::SendRichMail'), 0, 0);
        }

    my ($sSmtpServer, $sEmailAddress, $sLocalError, $sSubjectText, $sMessageText, $sMessageHTML, $sBoundary, $sReturnAddress);
    ($sSmtpServer, $sEmailAddress, $sSubjectText, $sMessageText, $sMessageHTML, $sReturnAddress) = @_;
    if (!$sReturnAddress)                                # if no return address defined
        {
        $sReturnAddress = $sEmailAddress;            # use the destination email address
        }
    #
    # Gather the SMTP host, server, and socket information
    #
    my ($nProto, $them, $nSmtpPort, $sLocalHost, $sMessage, $serverIP);

    my $sLocalhost = GetHostname();                        # get the local machine ip address
    if ($sLocalhost eq '')
        {
        $sLocalhost = 'www.actinic.com';
        }

    $nProto = getprotobyname('tcp');
    $nSmtpPort = 25;                                        # Use default port

    $serverIP = inet_aton($sSmtpServer);            # due the dns lookup and get the ip address
    if (!defined $serverIP)
        {
        return($::FAILURE, GetPhrase(-1, 13, $!), 0, 0); # Record internal error
        }

    $them = sockaddr_in($nSmtpPort, $serverIP);    # create the sockaddr
    if (!defined $them)
        {
        return($::FAILURE, GetPhrase(-1, 14, $!), 0, 0); # Record internal error
        }

    unless (socket(MYSOCKET, PF_INET, SOCK_STREAM, $nProto))    # create the socked
        {
        return($::FAILURE, GetPhrase(-1, 15, $!), 0, 0); # Record internal error
        }

    unless (connect(MYSOCKET, $them))                # connect to the remote host
        {
        $sLocalError = GetPhrase(-1, 16, $!);        # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    binmode MYSOCKET;                                        # just incase

    my($oldfh) = select(MYSOCKET);                    # make MYSOCKET the current file handle
    $| = 1;                                                    # make each command send a flush
    select($oldfh);                                        # return to the default file handle

    $sMessage = <MYSOCKET>;                                # see what the SMTP server has to say
    if ($sMessage =~ /^[45]/)                            # check for failures from the SMTP server
        {
        $sLocalError = GetPhrase(-1, 17, 1, $sMessage);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    unless (print MYSOCKET "HELO $sLocalhost\r\n")    # start the conversation with the SMTP server
        {
        $sLocalError = GetPhrase(-1, 18, 1, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    $sMessage = <MYSOCKET>;                                # see what the SMTP server has to say
    if ($sMessage =~ /^[45]/)                            # check for failures
        {
        $sLocalError = GetPhrase(-1, 17, 2, $sMessage);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    unless (print MYSOCKET "MAIL FROM:<" . $sReturnAddress . ">\r\n") # specify the origin
        {
        $sLocalError = GetPhrase(-1, 18, 2, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    $sMessage = <MYSOCKET>;                                # see what the SMTP server has to say
    if ($sMessage =~ /^[45]/)                            # check for failures
        {
        $sLocalError = GetPhrase(-1, 17, 3, $sMessage);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    unless (print MYSOCKET "RCPT TO:<",$sEmailAddress,">\r\n") # reciepient is always the supplier
        {
        $sLocalError = GetPhrase(-1, 18, 3, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    $sMessage = <MYSOCKET>;                                # see what the SMTP server has to say
    if ($sMessage =~ /^[45]/)                            # check for failures
        {
        $sLocalError = GetPhrase(-1, 17, 4, $sMessage);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    unless (print MYSOCKET "DATA\r\n")                # the rest of the is the message body until the <CRLF>.<CRLF>
        {
        $sLocalError = GetPhrase(-1, 18, 4, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    $sMessage = <MYSOCKET>;                                # see what the SMTP server has to say
    if ($sMessage =~ /^[45]/)                            # check for failure
        {
        $sLocalError = GetPhrase(-1, 17, 5, $sMessage);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    if ($sMessageText ne '' && $sMessageHTML ne '')# if both messages are specified
        {
        #
        # make up our multi-part boundary from the order number
        #
        $sBoundary = "------------" . $::g_InputHash{ORDERNUMBER};
        #
        # let server know we are sending MIME
        #
        unless (print MYSOCKET "MIME-Version: 1.0\r\n") # MIME version
            {
            $sLocalError = GetPhrase(-1, 18, 11, $!);    # Record internal error
            close MYSOCKET;
            return($::FAILURE, $sLocalError, 0, 0);
            }
        }
    else                                                        # this isn't a multi-part message
        {
        $sBoundary = "";                                    # clear the boundary
        }

    unless (print MYSOCKET "From: $sReturnAddress\r\n") # subject
        {
        $sLocalError = GetPhrase(-1, 18, 5, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    unless (print MYSOCKET "Subject: $sSubjectText\r\n") # subject
        {
        $sLocalError = GetPhrase(-1, 18, 6, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    unless (print MYSOCKET "To: $sEmailAddress\r\n") # subject
        {
        $sLocalError = GetPhrase(-1, 18, 7, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    unless (print MYSOCKET "Reply-To: $sReturnAddress\r\n") # subject
        {
        $sLocalError = GetPhrase(-1, 18, 8, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    if ($sBoundary ne '')                                # if both message types are specified
        {
        my $sContentMultipart = "Content-Type: multipart/alternative; ";
        $sContentMultipart .= "boundary=\"" . $sBoundary . "\"\r\n\r\n";

        unless (print MYSOCKET $sContentMultipart) # content-type
            {
            $sLocalError = GetPhrase(-1, 18, 12, $!);    # Record internal error
            close MYSOCKET;
            return($::FAILURE, $sLocalError, 0, 0);
            }
        }

    unless (print MYSOCKET "\r\n")                    # blank line
        {
        $sLocalError = GetPhrase(-1, 18, 8, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    if ($sBoundary ne '')                                # if both message types are specified
        {
        #
        # send the text multipart
        #
        my $sTextMultipart = "--" . $sBoundary . "\r\n";
        $sTextMultipart .= "Content-Type: text/plain; charset=us-ascii\r\n";
        $sTextMultipart .= "Content-Transfer-Encoding: 7bit\r\n\r\n" . $sMessageText . "\r\n\r\n";

        unless (print MYSOCKET $sTextMultipart)    # text content
            {
            $sLocalError = GetPhrase(-1, 18, 13, $!);    # Record internal error
            close MYSOCKET;
            return($::FAILURE, $sLocalError, 0, 0);
            }

        #
        # send the HTML multipart
        #
        my $sHTMLMultipart = "--" . $sBoundary . "\r\n";
        $sHTMLMultipart .= "Content-Type: text/html; charset=us-ascii\r\n";
        $sHTMLMultipart .= "Content-Transfer-Encoding: 7bit\r\n\r\n" . $sMessageHTML . "\r\n\r\n";

        unless (print MYSOCKET $sHTMLMultipart)    # HTML content
            {
            $sLocalError = GetPhrase(-1, 18, 14, $!);    # Record internal error
            close MYSOCKET;
            return($::FAILURE, $sLocalError, 0, 0);
            }

        #
        # send the final boundary
        #
        my $sEndMultipart = "--" . $sBoundary . "--\r\n";
        unless (print MYSOCKET $sEndMultipart)        # multipart terminator
            {
            $sLocalError = GetPhrase(-1, 18, 15, $!);    # Record internal error
            close MYSOCKET;
            return($::FAILURE, $sLocalError, 0, 0);
            }
        }
    else
        {
        unless (print MYSOCKET "$sMessageText\r\n")    # just spacing
            {
            $sLocalError = GetPhrase(-1, 17, 6, $sMessage); # Record internal error
            close MYSOCKET;
            return($::FAILURE, $sLocalError, 0, 0);
            }
        }
    unless (print MYSOCKET "\r\n.\r\n")                # finish the message
        {
        $sLocalError = GetPhrase(-1, 18, 9, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    $sMessage = <MYSOCKET>;                                # see what the SMTP server has to say
    if ($sMessage =~ /^[45]/)                            # check for failures
        {
        $sLocalError = GetPhrase(-1, 17, 7, $sMessage);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    unless (print MYSOCKET "QUIT\r\n")                    # end the conversation
        {
        $sLocalError = GetPhrase(-1, 18, 10, $!);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    $sMessage = <MYSOCKET>;                                # see what the SMTP server has to say
    if ($sMessage =~ /^[45]/)                            # check for failures
        {
        $sLocalError = GetPhrase(-1, 17, 8, $sMessage);    # Record internal error
        close MYSOCKET;
        return($::FAILURE, $sLocalError, 0, 0);
        }

    shutdown MYSOCKET, 1;                                # shutdown sends
    close MYSOCKET;                                        # done

    return($::SUCCESS, '', 0, 0);
    }

#######################################################
#
# GetCookie - retrieve the actinic cookie
#
# Returns:    0 - cookie (undef if undefined)
#
#######################################################

sub GetCookie
    {
    my ($sCartID, $sContactDetails) = GetCookies();
    return ($sCartID);
    }

#######################################################
#
# GetCookies - retrieve the actinic cookies
#
# Returns:    0 - cart ID (undef if undefined)
#                1 - checkout details (undef if undefined)
#
#######################################################

sub GetCookies
    {
    my ($sCookie, $sCookies);
    $sCookies = $::ENV{'HTTP_COOKIE'};                # try to retrieve the cookie
    my (@CookieList) = split(/;/, $sCookies);        # separate the various cookie variables in the list
    my ($sLabel);
    my $bFound = $::FALSE;                                # true when one of the cookies has been found
    my ($sCartID, $sContactDetails);
    foreach $sCookie (@CookieList)
        {
        $sCookie =~ s/^\s*//;                            # strip leading white space
        if ($sCookie =~ /^ACTINIC_CART/)                # found the cart ID
            {
            ($sLabel, $sCartID) = split (/=/, $sCookie);    # retrieve the value
            #
            # Make the cart ID secure by locking out any shell type characters
            #
            $sCartID =~ /([a-zA-Z0-9]+)/;                # cart ID's are just characters
            $sCartID = $1;

            if ($bFound)                                    # if the other cookie has already been found
                {
                last;                                            # exit the loop
                }
            else                                                # this is the first of the two cookies to be found
                {
                $bFound = $::TRUE;                        # note that we found it
                }
            }
        elsif ($sCookie =~ /^ACTINIC_CONTACT/)        # found the contact details
            {
            ($sLabel, $sContactDetails) = split (/=/, $sCookie);    # retrieve the value
            #
            # strip any trailing or leading quotes and spaces
            #
            $sContactDetails =~ s/^\s*"?//;        # " # here for emacs formatting
            $sContactDetails =~ s/"?\s*$//;        # " # here for emacs formatting

            if ($bFound)                                    # if the other cookie has already been found
                {
                last;                                            # exit the loop
                }
            else                                                # this is the first of the two cookies to be found
                {
                $bFound = $::TRUE;                        # note that we found it
                }
            }
        }
    return ($sCartID, $sContactDetails);
    }

#######################################################
#
# GetReferrer - retrieve the referrer URL
#
# Returns:    0 - referring URL
#
#######################################################

sub GetReferrer
    {
#? ACTINIC::ASSERT(defined %::g_InputHash, "g_InputHash is undefined in GetReferrer", __LINE__, __FILE__);
    my ($sURL);
    $sURL = $::ENV{"HTTP_REFERER"};                    # try to retrieve the cookie
    if (defined %::g_InputHash &&
         defined $::g_InputHash{ACTINIC_REFERRER})
        {
        $sURL = $::g_InputHash{ACTINIC_REFERRER};
        }
    return ($sURL);
    }

#######################################################
#
# TrimHashEntries - trim leading and trailing white
#    space from every value in the hash table
#
# Params:    0 - in/out - pointer to the hash
#
#######################################################

sub TrimHashEntries
    {
#? ACTINIC::ASSERT(0 == $#_, "Invalid parameter count in TrimHashEntries, $#_", __LINE__, __FILE__);
    my $pHash = $_[0];
    #
    # process each entry in the hash
    #
    my ($key, $value);
    while ( ($key, $value) = each %$pHash)
        {
        $$pHash{$key} =~ s/^\s*(.*?)\s*$/$1/gs;
        }
    }

##################################################################################
#                                                                                                            #
# HTML manipulation functions - begin                                                            #
#                                                                                                            #
##################################################################################

#######################################################
#
# ProcessEscapableText - encode the text from the
#    specified string leaving escaped regions raw.
#
# Params:    0 - the string to convert
#
# Returns:    0 - status
#                1 - modified string or error message (if any)
#                2 - 0
#                3 - 0
#
#######################################################

sub ProcessEscapableText
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ProcessEscapableText ($#_)", __LINE__, __FILE__);

    my ($sString) = @_;
    #
    # first see if there is any escaped text
    #
    my (@Response);
    if ($sString !~ /!!</)                                # no escaped text
        {
        return (EncodeText($sString));                # encode it
        }
    #
    # pick apart the string
    #
    my (@PartsList) = ($sString =~  m/((.*?)!!<(.*?)>!!)*/g);
    my ($sEndPart) = ($sString =~ m/>!!(.*?)$/g); # get the closing encode text
    #
    # Now @PartsList contains a series of segments of the following pattern:
    #
    #        element        description
    #            0            the entire segment - throw out
    #            1            text to encode
    #            2            raw HTML
    #
    my ($sPart, $sNewString, $nCount, $nElement);
    $nCount = 0;
    foreach $sPart (@PartsList)
        {
        $nElement = Modulus($nCount, 3);            # calculate the element number

        if ($nElement == 0)                                # the entire segment
            {
            # no-op - throw out
            }
        elsif ($nElement == 1)                            # text to be encoded
            {
            @Response = EncodeText($sPart);            # encode it
            if ($Response[0] != $::SUCCESS)
                {
                return (@Response);
                }
            $sNewString .= $Response[1];
            }
        elsif ($nElement == 2)                            # raw HTML
            {
            $sNewString .= $sPart;
            }
        $nCount++;
        }
    #
    # the end part needs to be encoded and included
    #
    @Response = EncodeText($sEndPart);                # encode it
    if ($Response[0] != $::SUCCESS)
        {
        return (@Response);
        }
    $sNewString .= $Response[1];                        # and include it

    return ($::SUCCESS, $sNewString, 0, 0);
    }

#######################################################
#
# EncodeText2 - convert then non-alphanumeric characters in
#    the supplied string to &#xx; where xx is the
#    equivalent decimal code for the character.  This is
#    needed for the HTML printout
#
# Params:    0 - the string to convert
#                1 - (optional) if TRUE, do HTML encoding (&#d;)
#                    if FALSE, do CGI encodeing (%x).  Default - TRUE
#                2 - (optional) if TRUE make spaces  ,
#                    default - FALSE.  Only makes sense in
#                    the context of 1 = TRUE
#
# Returns:    0 - modified string
#
#######################################################

sub EncodeText2
    {
    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my @Response = EncodeText(@_);
#? ACTINIC::ASSERT($Response[0] == $::SUCCESS, "It looks like EncodeText can return an error.", __LINE__, __FILE__);
    return ($Response[1]);
    }

#######################################################
#
# EncodeText - convert then non-alphanumeric characters in
#    the supplied string to &#xx; where xx is the
#    equivalent decimal code for the character.  This is
#    needed for the HTML printout
#
# Params:    0 - the string to convert
#                1 - (optional) if TRUE, do HTML encoding (&#d;)
#                    if FALSE, do CGI encodeing (%x).  Default - TRUE
#                2 - (optional) if TRUE make spaces  ,
#                    default - FALSE.  Only makes sense in
#                    the context of 1 = TRUE
#
# Returns:    0 - status
#                1 - modified string or error message (if any)
#                2 - 0
#                3 - 0
#
#######################################################

sub EncodeText
    {
#? ACTINIC::ASSERT($#_ >= 0, "Invalid argument count in EncodeText ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($sString, $bHtmlEncoding, $bNBSP) = @_;
    if (!defined $bHtmlEncoding)                        # default encoding is HTML
        {
        $bHtmlEncoding = $::TRUE;
        }
    if (!defined $bNBSP)                                    # default NBSP is FALSE
        {
        $bNBSP = $::FALSE;
        }
    #
    # Do the substitution.
    #
    if ($bHtmlEncoding)                                    # HTML encoding
        {
        $sString =~ s/(\W)/sprintf('&#%d;', ord($1))/eg;    # regular space substitution
        }
    else                                                        # CGI encoding
        {
        $sString =~ s/(\W)/sprintf('%%%2.2x', ord($1))/eg;    # regular space substitution
        }

    if ($bNBSP)                                                # if we want non-breaking spaces
        {
        $sString =~ s/ / /g;                    # replace the normal spaces with the non-breaking versions
        }                                                        # NOTE: this does nothing if ! $bHtmlEncoding

    return ($::SUCCESS, $sString, 0, 0);
    }

#######################################################
#
# DecodeText - this function is similar
#    to EncodeText with two exceptions: 1) it deals with
#    characters stored as %xx and 2) it works in reverse
#    restoring the character for the % value
#
# Params:    0 - the string to convert
#                1 - decode method flag $ACTINIC::FORM_URL_ENCODED or $ACTINIC::MODIFIED_FORM_URL_ENCODED
#                    $ACTINIC::FORM_URL_ENCODED = decode using application/x-www-form-urlencoded (%xx)
#                    $ACTINIC::MODIFIED_FORM_URL_ENCODED = Actinic format - identical to $::FORM_URL_ENCODED except an
#                        underscore is used instead of a percent sign and the string is
#                        prepended with an "a".  This encoding is used to map arbitrary
#                        strings into HTML "ID and NAME" data types.
#                        NAME tokens must begin with a letter ([A-Za-z]) and may be
#                        followed by any number of letters, digits ([0-9]), hyphens ("-"),
#                        underscores ("_"), colons (":"), and periods (".")
#
# Returns:    ($sString) - the converted string
#
#######################################################

sub DecodeText
    {
#? ACTINIC::ASSERT($#_ == 1, "Invalid argument count in DecodeText ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($sString, $eEncoding) = @_;

    if ($eEncoding == $ACTINIC::MODIFIED_FORM_URL_ENCODED)
        {
        $sString =~ s/^a//;                                # string the leading a
        $sString =~ s/_([A-Fa-f0-9]{2})/pack('c',hex($1))/ge;    # Convert _XX from hex numbers to character equivalent
        }
    elsif ($eEncoding == $ACTINIC::FORM_URL_ENCODED)
        {
        $sString =~ s/\+/ /g;                            # replace + signs with the spaces they represent
        $sString =~ s/%([A-Fa-f0-9]{2})/pack('c',hex($1))/ge;    # Convert %XX from hex numbers to character equivalent
        }
    else
        {
#? ACTINIC::ASSERT($::FALSE, 'Invalid encodgin argument to DecodeText' . " ($eEncoding)", __LINE__, __FILE__);
        }

    return ($sString);
    }

#######################################################
#
# TemplateFile - replace the vars in the template file
#    with the values stored in the variable table
#
# Params:    0 - template filename
#                1 - a reference to the variable table
#
# Returns:  0 - $::SUCCESS or $::FAILURE on error
#                1 - error message
#                2 - modified HTML
#                3 - 0
#
#######################################################

sub TemplateFile
    {
#? ACTINIC::ASSERT($#_ >= 0, "Invalid argument count in TemplateFile ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($sFilename, $pVariableTable);
    ($sFilename, $pVariableTable) = @_;

    unless (open (TFFILE, "<$sFilename"))
        {
        return($::FAILURE, GetPhrase(-1, 21, $sFilename, $!), '', 0);
        }

    my ($sOutput);
    {
    local $/;
    $sOutput = <TFFILE>;                                # read the entire file
    }
    close (TFFILE);

    return (TemplateString($sOutput, $pVariableTable));
    }

#######################################################
#
# TemplateString - replace the vars in the template
#    string with their values
#
# Params:    0 - template string
#                1 - a reference to the variable table
#
# Returns:  0 - $::SUCCESS or $::FAILURE on error
#                1 - error message
#                2 - modified HTML
#                3 - 0
#
#######################################################

sub TemplateString
    {
#? ACTINIC::ASSERT($#_ == 1, "Invalid argument count in TemplateString ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($sString, $pVariableTable);
    ($sString, $pVariableTable) = @_;

    if(defined $$pVariableTable{'NETQUOTEVAR:ADVANCEDTAXHTML'})
        {
        my %hashEmpty = {};
        my @Response = TemplateFile(GetPath()."advancedtax.html", \%hashEmpty);
        if ($Response[0] != $::SUCCESS)
            {
            return (@Response);
            }
        $sString =~ s/(NETQUOTEDEL:TAXPHASE)(.*?)NETQUOTEVAR:TAXPROMPT.*?NETQUOTEDEL:TAXPHASE/$1$Response[2]$1/isg;                # replace the variable with its value
        delete $$pVariableTable{'NETQUOTEVAR:ADVANCEDTAXHTML'};
        }

    my ($key, $value);
    while (($key, $value) = each %$pVariableTable)# for every variable in the table
        {
        $sString =~ s/$key/$value/isg;                # replace the variable with its value
        }

    return ($::SUCCESS, '', $sString, 0);
    }

#######################################################
#
# ReturnToLastPage - bounce the browser to the previous
#    page
#
# Params:    0 - bounce delay (if less than 0, don't
#                    automatically bounce)
#                1 - string to add to display
#                2 - optional page title.  If the page
#                        title exists (ne ''), the page is formatted
#                        using the bounce template
#                3 - pointer to the page list
#                4 - the refering site URL
#                5 - content site URL
#                6 - pointer to the setup blob
#                7+ - InputHash table
#
# Returns:    0 - status
#                1 - error message
#                2 - HTML for the bounce page
#
#######################################################

sub ReturnToLastPage
    {
#? ACTINIC::ASSERT($#_ > 7, "Invalid argument count in ReturnToLastPage ($#_)", __LINE__, __FILE__);

    if ($_[1] ne '')                                        # if the page title is defined, format the page prettily
        {
        return (ReturnToLastPageEnhanced(@_));
        }
    else                                                        # otherwise, use a plain page
        {
        return (ReturnToLastPagePlain(@_));
        }
    }

#######################################################
#
# GroomError - make the error look nice for the HTML
#
# Params:    0 - Error string
#
# Returns:    0 - pretty string
#
#######################################################

sub GroomError
    {
    if ($#_ != 0)
        {
        return (GroomError(ACTINIC::GetPhrase(-1, 12, 'GroomError')));
        }
    my ($sError) = @_;

    if ($sError eq "")
        {
        return ($sError);
        }

    $sError = "<TABLE CELLPADDING=\"10\" WIDTH=\"550\" BORDER=\"1\" BGCOLOR=\"$$::g_pSetupBlob{FORM_BACKGROUND_COLOR}\">" .
        "<TR><TD><BIG> $sError</BIG></TD></TR></TABLE><P><HR>";

    return ($sError);
    }

#######################################################
#
# GroomHTML - Display HTML in catalog style
#    NOTE: this is a wrapper for the ACTINIC
#    package version.  It prevents a bunch of duplicate
#    work
#
# Params:    [0] - string to add to display
#                [1] - optional page title.  If the page
#                        title exists, the page is formatted
#                        using the bounce template
#                2 - pointer to the page list
#                3 - the refering site URL
#                4 - content site URL
#                5 - pointer to the setup blob
#                6+ - InputHash table
#
# Expects:    %::g_InputHash should be defined
#
# Returns:    ($ReturnCode, $Error, $sHTML, 0)
#                if $ReturnCode = $::FAILURE, the operation failed
#                    for the reason specified in $Error
#                Otherwise everything is OK
#                $sHTML - the HTML of the page
#
#######################################################

sub GroomHTML
    {
#? ACTINIC::ASSERT($#_ > 6, "Invalid argument count in GroomHTML ($#_)", __LINE__, __FILE__);

    my ($sHTML, $sMessage, $sRefPage, $sScriptName);
    my (%InputHash, $temp, $pPageList, $sTitle, $pSetupBlob, $sContentUrl, $sWebSiteUrl);
    ($sMessage, $sTitle, $pPageList, $sWebSiteUrl, $sContentUrl, $pSetupBlob, %InputHash) = @_;

    pop @$pPageList;                                        # throw out the current page
    $sRefPage = pop @$pPageList;                        # get the previous page

    $sScriptName = GetScriptNameRegexp();
    if ($sRefPage =~ /$sScriptName/)                    # if the referring page was a script call,
        {
        #
        # get the page history - note that passing '' as the first argument guarantees tha prevquery will
        # be meaningless
        #
        my ($status, $sMessage, $sPrevQuery, $sPageHistory) = PrepareRefPageData('', $pPageList, $::TRUE);
        if ($status != $::SUCCESS)
            {
            return($status, $sMessage, '');
            }
        #
        # tack the "END" on so ReadAndParseInput knows this was a bounce
        #
        $sRefPage .= '&' . "REFPAGE=" . $sPageHistory . "END";        # this must be the last thing in the query statement
        }

    return (GroomHTMLEnhanced($sMessage, $sTitle, $pPageList,
        $sWebSiteUrl, $sContentUrl, $pSetupBlob, $sRefPage, \%InputHash));
    }

#######################################################
#
# GroomHTMLEnhanced - Format the page contents using
#    the bounce.html template
#
# Params:    0 - string to add to display
#                0 - optional page title.  If the page
#                        title exists (ne ''), the page is formatted
#                        using the bounce template
#                2 - pointer to the page list
#                3 - the refering site URL
#                4 - content site URL
#                5 - pointer to the setup blob
#                6 - the page to go to
#                7 - pointer to InputHash table
#
# Returns:    0 - status
#                1 - error message
#                2 - HTML for the page
#
#######################################################

sub GroomHTMLEnhanced
    {
#? ACTINIC::ASSERT($#_ > 6, "Invalid argument count in GroomHTMLEnhanced ($#_)", __LINE__, __FILE__);
    my ($sHTML, $sMessage, $sScriptName);
    my ($pInputHash, $temp, $pPageList, $sTitle, $pSetupBlob, $sWebSiteUrl, $sContentUrl, $sRefPage);
    ($sMessage, $sTitle, $pPageList, $sWebSiteUrl, $sContentUrl, $pSetupBlob, , $sRefPage, $pInputHash) = @_;

    my ($sPath, @Response, $Status, $Message);
    $sPath = GetPath();                                    # get the path to the web site dir

    my (%VariableTable);
    $VariableTable{$::VARPREFIX."BOUNCETITLE"} = $sTitle; # add the title to the var list
    $VariableTable{$::VARPREFIX."BOUNCEMESSAGE"} = $sMessage; # add the message to the var list

    @Response = TemplateFile($sPath."bounce.html", \%VariableTable); # make the substitutions
    ($Status, $Message, $sHTML) = @Response;
    if ($Status != $::SUCCESS)
        {
        return (@Response);
        }

    #######
    # make the file references point to the correct directory
    #######
    @Response = MakeLinksAbsolute($sHTML, $sWebSiteUrl, $sContentUrl);
    ($Status, $Message, $sHTML) = @Response;
    if ($Status != $::SUCCESS)
        {
        return (@Response);
        }

    return ($::SUCCESS, '', $sHTML, 0);
    }

#######################################################
#
# ReturnToLastPagePlain - bounce the browser to the
#    previous page using a plain white page
#
# Params:    0 - bounce delay (if less than 0, don't
#                    automatically bounce)
#                1 - string to add to display
#                2 - optional page title.  If the page
#                        title exists (ne ''), the page is formatted
#                        using the bounce template
#                3 - pointer to the page list
#                4 - the refering site URL
#                5 - content site URL
#                6 - pointer to the setup blob
#                7+ - InputHash table
#
# Returns:    0 - status
#                1 - error message
#                2 - HTML for the bounce page
#
#######################################################

sub ReturnToLastPagePlain
    {
#? ACTINIC::ASSERT($#_ > 7, "Invalid argument count in ReturnToLastPagePlain ($#_)", __LINE__, __FILE__);
    my ($sHTML, $nDelay, $sMessage, $sRefPage, $sScriptName, %InputHash, $temp, $pPageList, $sWebSiteUrl, $sContentUrl, $pSetupBlob);
    ($nDelay, $sMessage, $temp, $pPageList, $sWebSiteUrl, $sContentUrl, $pSetupBlob, %InputHash) = @_;

    pop @$pPageList;                                        # throw out the current page
    $sRefPage = pop @$pPageList;                        # get the previous page

    $sScriptName = GetScriptNameRegexp();
    if ($sRefPage =~ /$sScriptName/)                    # if the referring page was a script call,
        {
        #
        # get the page history - note that passing '' as the first argument guarantees tha prevquery will
        # be meaningless
        #
        my ($status, $sMessage, $sPrevQuery, $sPageHistory) = PrepareRefPageData('', $pPageList, $::TRUE);
        if ($status != $::SUCCESS)
            {
            return($status, $sMessage, '');
            }
        #
        # tack the "END" on so ReadAndParseInput knows this was a bounce
        #
        $sRefPage .= '&' . "REFPAGE=" . $sPageHistory . "END";        # this must be the last thing in the query statement
        }

    return (BounceToPagePlain($nDelay, $sMessage, $temp, $pPageList,
        $sWebSiteUrl, $sContentUrl, $pSetupBlob, $sRefPage, \%InputHash));
    }

#######################################################
#
# BounceToPagePlain - bounce the browser to the
#    specified page using a simple page
#
# Params:    0 - bounce delay (if less than 0, don't
#                    automatically bounce)
#                1 - string to add to display
#                2 - optional page title.  If the page
#                        title exists (ne ''), the page is formatted
#                        using the bounce template
#                3 - pointer to the page list
#                4 - the refering site URL
#                5 - content site URL
#                6 - pointer to the setup blob
#                7 - URL to go to
#                8 - InputHash table
#                9 - clear frames flag - if $::TRUE,
#                   clear any existing
#                    frames when bouncing.   Default: $::FALSE
#
# Returns:    0 - status
#                1 - error message
#                2 - HTML for the bounce page
#
#######################################################

sub BounceToPagePlain
    {
#? ACTINIC::ASSERT($#_ > 7, "Wrong number of arguments in BounceToPagePlain ($#_)", __LINE__, __FILE__);

    my ($sHTML, $nDelay, $sMessage, $sRefPage, $sScriptName, $pInputHash);
    my ($temp, $pPageList, $sWebSiteUrl, $sContentUrl, $pSetupBlob, $bClearFrames);
    ($nDelay, $sMessage, $temp, $pPageList, $sWebSiteUrl, $sContentUrl, $pSetupBlob, $sRefPage, $pInputHash, $bClearFrames) = @_;
    #
    # set the flag to clear the flag if it exists and clearing was requested
    #
#    $bClearFrames = $bClearFrames;                    # What is this for?

    my ($sDigest,$sBaseFile) = ACTINIC::CaccGetCookies();
    if( !$sDigest )
        {
        $sWebSiteUrl = $sContentUrl;
        }
    else
        {
        $sWebSiteUrl = $sBaseFile;
        $sWebSiteUrl =~ s#/[^/]*$#/#;
        }
    if ($sRefPage eq '')                                    # if no referring page, ask the user to manually return
        {
        $sHTML = "<HTML>\n";                                # open page
        $sHTML .= "<BODY";                                # body definition
        if ($$pSetupBlob{'BACKGROUND_IS_IMAGE'} &&
             length $$pSetupBlob{'BACKGROUND_VALUE'} > 0)
            {
            $sHTML .= " BACKGROUND=\"" . $sWebSiteUrl . $$pSetupBlob{'BACKGROUND_VALUE'} . "\"";
            }
        elsif (length $$pSetupBlob{'BACKGROUND_VALUE'} > 0)
            {
            $sHTML .= " BGCOLOR=\"" . $$pSetupBlob{'BACKGROUND_VALUE'} . "\"";
            }
        if (length $$pSetupBlob{'FOREGROUND_COLOR'} > 0)
            {
            $sHTML .= " TEXT=\"" . $$pSetupBlob{'FOREGROUND_COLOR'} . "\""
            }
        if (length $$pSetupBlob{'LINK_COLOR'} > 0)
            {
            $sHTML .= " LINK=\"" . $$pSetupBlob{'LINK_COLOR'} . "\""
            }
        if (length $$pSetupBlob{'ALINK_COLOR'} > 0)
            {
            $sHTML .= " ALINK=\"" . $$pSetupBlob{'ALINK_COLOR'} . "\""
            }
        if (length $$pSetupBlob{'VLINK_COLOR'} > 0)
            {
            $sHTML .= " VLINK=\"" . $$pSetupBlob{'VLINK_COLOR'} . "\""
            }
        $sHTML .= "><BLOCKQUOTE>\n";
        $sHTML .= $sMessage."<P>\n";                    # add the call specific message (if any)
        $sHTML .= GetPhrase(-1, 22) . "<BR></BLOCKQUOTE>\n";
        }
    else                                                        # bounce to the referring page
        {
        $sHTML = "<HTML>\n";                                # open page
        if( $$pInputHash{MAINFRAMEURL} and $sRefPage =~ /\?/ )    # For parsed frameset we may change main frame URL
            {
            $sRefPage .= "$`" . '?MAINFRAMEURL=' . $$pInputHash{MAINFRAMEURL} . "\&$'";
            }
        if ($nDelay >= 0)                                    # only try to auto bounce if the delay is a positive number
            {
            my $sMetaTag;
            if ($bClearFrames)                            # use JavaScript to clear frames on the auto-bounce
                {
                $sMetaTag =
                    "<SCRIPT LANGUAGE=\"JAVASCRIPT\">\n" .
                    "<!-- hide from older browsers\n" .
                    "setTimeout(\"ForwardPage()\", " . 1000 * $nDelay . ");\n" .
                    "function ForwardPage()\n" .
                    "    {\n" .
                    "    parent.location.replace('$sRefPage');\n" .
                    "    }\n" .
                    "// -->\n" .
                    "</SCRIPT>\n";
                }
            else                                                # no need for the JavaScript, so use the more commonly supported Meta tag
                {
                $sMetaTag = "<META HTTP-EQUIV=\"refresh\" "; # refresh message
                $sMetaTag .= "CONTENT=\"$nDelay; URL=".$sRefPage."\">\n";
                }
            $sHTML .= $sMetaTag;
            }

        $sHTML .= "<BODY";                                # body definition
        if ($$pSetupBlob{'BACKGROUND_IS_IMAGE'} &&
             length $$pSetupBlob{'BACKGROUND_VALUE'} > 0)
            {
            $sHTML .= " BACKGROUND=\"" . $sWebSiteUrl . $$pSetupBlob{'BACKGROUND_VALUE'} . "\"";
            }
        elsif (length $$pSetupBlob{'BACKGROUND_VALUE'} > 0)
            {
            $sHTML .= " BGCOLOR=\"" . $$pSetupBlob{'BACKGROUND_VALUE'} . "\"";
            }
        if (length $$pSetupBlob{'FOREGROUND_COLOR'} > 0)
            {
            $sHTML .= " TEXT=\"" . $$pSetupBlob{'FOREGROUND_COLOR'} . "\""
            }
        if (length $$pSetupBlob{'LINK_COLOR'} > 0)
            {
            $sHTML .= " LINK=\"" . $$pSetupBlob{'LINK_COLOR'} . "\""
            }
        if (length $$pSetupBlob{'ALINK_COLOR'} > 0)
            {
            $sHTML .= " ALINK=\"" . $$pSetupBlob{'ALINK_COLOR'} . "\""
            }
        if (length $$pSetupBlob{'VLINK_COLOR'} > 0)
            {
            $sHTML .= " VLINK=\"" . $$pSetupBlob{'VLINK_COLOR'} . "\""
            }
        $sHTML .= "><BLOCKQUOTE>\n";
        $sHTML .= $sMessage."<P>\n";                    # add the call specific message (if any)
        my $sBounceSentence;
        if ($nDelay >= 0)                                    # if the delay is a positive number
            {
            $sBounceSentence = GetPhrase(-1, 23, $sRefPage) . "\n"; # try to automatically bounce or here
            }
        else                                                    # negative delay means no auto bounce
            {
            $sBounceSentence = GetPhrase(-1, 161, $sRefPage) . "\n"; # click here to continue
            }
        #
        # if we are to clear the frames in the jump, add the target to this URL
        #
        if ($bClearFrames)
            {
            $sBounceSentence =~ s/(HREF=)/TARGET="_parent" $1/i;
            }
        #
        # add the message to the page
        #
        $sHTML .= $sBounceSentence . "<BLOCKQUOTE>";
        }
    $sHTML .= "</BODY>\n</HTML>\n";

    return ($::SUCCESS, '', $sHTML, 0);
    }

#######################################################
#
# ReturnToLastPageEnhanced - bounce the browser to the
#    previous page, but format the page contents using
#    the bounce.html template
#
# Params:    0 - bounce delay (if less than 0, don't
#                    automatically bounce)
#                1 - string to add to display
#                2 - optional page title.  If the page
#                        title exists (ne ''), the page is formatted
#                        using the bounce template
#                3 - pointer to the page list
#                4 - the refering site URL
#                5 - content site URL
#                6 - pointer to the setup blob
#                7+ - InputHash table
#
# Returns:    0 - status
#                1 - error message
#                2 - HTML for the bounce page
#
#######################################################

sub ReturnToLastPageEnhanced
    {
#? ACTINIC::ASSERT($#_ > 7, "Invalid argument count in ReturnToLastPageEnhanced ($#_)", __LINE__, __FILE__);
    my ($sHTML, $nDelay, $sMessage, $sRefPage, $sScriptName);
    my (%InputHash, $temp, $pPageList, $sTitle, $sMetaTag, $pSetupBlob, $sContentUrl, $sWebSiteUrl);
    ($nDelay, $sMessage, $temp, $pPageList, $sWebSiteUrl, $sContentUrl, $pSetupBlob, %InputHash) = @_;

    pop @$pPageList;                                        # throw out the current page
    $sRefPage = pop @$pPageList;                        # get the previous page

    $sScriptName = GetScriptNameRegexp();
    if ($sRefPage =~ /$sScriptName/)                    # if the referring page was a script call,
        {
        #
        # get the page history - note that passing '' as the first argument guarantees tha prevquery will
        # be meaningless
        #
        my ($status, $sMessage, $sPrevQuery, $sPageHistory) = PrepareRefPageData('', $pPageList, $::TRUE);
        if ($status != $::SUCCESS)
            {
            return($status, $sMessage, '');
            }
        #
        # tack the "END" on so ReadAndParseInput knows this was a bounce
        #
        $sRefPage .= '&' . "REFPAGE=" . $sPageHistory . "END";        # this must be the last thing in the query statement
        }

    return (BounceToPageEnhanced($nDelay, $sMessage, $sTitle, $pPageList,
        $sWebSiteUrl, $sContentUrl, $pSetupBlob, $sRefPage, \%InputHash));
    }

#######################################################
#
# BounceToPageEnhanced - bounce the browser to the
#    specified page, but format the page contents using
#    the bounce.html template
#
# Params:    0 - bounce delay (if less than 0, don't
#                    automatically bounce)
#                1 - string to add to display
#                2 - optional page title.  If the page
#                        title exists (ne ''), the page is formatted
#                        using the bounce template
#                3 - pointer to the page list
#                4 - the refering site URL
#                5 - content site URL
#                6 - pointer to the setup blob
#                7 - the page to go to
#                8 - pointer to InputHash table
#                9 - clear frames flag - if $::TRUE,
#                    clear any existing
#                    frames when bouncing.   Default: $::FALSE
#
# Returns:    0 - status
#                1 - error message
#                2 - HTML for the bounce page
#
#######################################################

sub BounceToPageEnhanced
    {
#? ACTINIC::ASSERT($#_ > 7, "Wrong number of arguments in BounceToPageEnhanced ($#_)", __LINE__, __FILE__);
    my ($sHTML, $nDelay, $sMessage, $sScriptName);
    my ($pInputHash, $temp, $pPageList, $sTitle, $sMetaTag, $pSetupBlob, $sWebSiteUrl, $sContentUrl, $sRefPage, $bClearFrames);
    ($nDelay, $sMessage, $sTitle, $pPageList, $sWebSiteUrl, $sContentUrl, $pSetupBlob, , $sRefPage, $pInputHash, $bClearFrames) = @_;
    #
    # set the flag to clear the flag if it exists and clearing was requested
    #
    #    $bClearFrames = $bClearFrames;                # I don't see what this is for (rz)

    if ($sRefPage eq '')                                    # if no referring page, ask the user to manually return
        {
        $sMessage .= "<P>\n";                            # add the bouncy message
        $sMessage .= GetPhrase(-1, 22) . "<BR>\n";
        $sMetaTag = '';                                    # no bounce command
        }
    else                                                        # bounce to the referring page
        {
        if( $$pInputHash{MAINFRAMEURL} and $sRefPage =~ /\?/ )    # For parsed frameset we may change main frame URL
            {
            $sRefPage .= "$`" . '?MAINFRAMEURL=' . $$pInputHash{MAINFRAMEURL} . "\&$'";
            }
        if ($nDelay >= 0)                                    # only try to auto bounce if the delay is a positive number
            {
            if ($bClearFrames)                            # use JavaScript to clear frames on the auto-bounce
                {
                $sMetaTag =
                    "<SCRIPT LANGUAGE=\"JAVASCRIPT\">\n" .
                    "<!-- hide from older browsers\n" .
                    "setTimeout(\"ForwardPage()\", " . 1000 * $nDelay . ");\n" .
                    "function ForwardPage()\n" .
                    "    {\n" .
                    "    parent.location.replace('$sRefPage');\n" .
                    "    }\n" .
                    "// -->\n" .
                    "</SCRIPT>\n";
                }
            else                                                # no need for the JavaScript, so use the more commonly supported Meta tag
                {
                $sMetaTag = "<META HTTP-EQUIV=\"refresh\" "; # refresh message
                $sMetaTag .= "CONTENT=\"$nDelay; URL=".$sRefPage."\">\n";
                }
            }

        $sMessage .= "<P>\n";                            # add the bouncy message
        my $sBounceSentence;
        if ($nDelay >= 0)                                    # if the delay is a positive number
            {
            $sBounceSentence = GetPhrase(-1, 23, $sRefPage) . "\n"; # try to automatically bounce or here
            }
        else                                                    # negative delay means no auto bounce
            {
            $sBounceSentence = GetPhrase(-1, 161, $sRefPage) . "\n"; # click here to continue
            }
        #
        # if we are to clear the frames in the jump, add the target to this URL
        #
        if ($bClearFrames)
            {
            $sBounceSentence =~ s/(HREF=)/TARGET="_parent" $1/i;
            }

        $sMessage .= $sBounceSentence;                # add the bounce line to the text
        }

    my ($sPath, @Response, $Status, $Message);
    $sPath = GetPath();                                    # get the path to the web site dir

    my (%VariableTable);
    $VariableTable{$::VARPREFIX."BOUNCETITLE"} = $sTitle; # add the title to the var list
    $VariableTable{$::VARPREFIX."BOUNCEMESSAGE"} = $sMessage; # add the message to the var list

    @Response = TemplateFile($sPath."bounce.html", \%VariableTable); # make the substitutions
    ($Status, $Message, $sHTML) = @Response;
    if ($Status != $::SUCCESS)
        {
        return (@Response);
        }

    #######
    # make the file references point to the correct directory
    #######
    my $smPath = $sContentUrl;
    my $sCgiUrl = $sWebSiteUrl;
    my ($sDigest,$sBaseFile) = ACTINIC::CaccGetCookies();
    if( $sDigest )
        {
        $smPath = ($sBaseFile) ? $sBaseFile : $sContentUrl;
        $sCgiUrl = $::g_sAccountScript;
        $sCgiUrl   .= $::g_InputHash{SHOP} ? '?SHOP=' . ACTINIC::EncodeText2($::g_InputHash{SHOP}, $::FALSE) . '&' : '?';
        $sCgiUrl   .= 'PRODUCTPAGE=' . $sRefPage;
        }
    @Response = MakeLinksAbsolute($sHTML, $sCgiUrl, $smPath);
    ($Status, $Message, $sHTML) = @Response;
    if ($Status != $::SUCCESS)
        {
        return (@Response);
        }

    my ($sSearchTag, $sReplaceTag);
    $sSearchTag = '</TITLE>';                            # the bounce meta tag comes immediately after the title
    $sReplaceTag = $sSearchTag . "\n" . $sMetaTag;

    $sHTML =~ s/$sSearchTag/$sReplaceTag/ig;        # insert the bounce meta tag

    return ($::SUCCESS, '', $sHTML, 0);
    }

#######################################################
#
# UpdateDisplay - Print the HTML to the browser after
#    modifying it to keep the page refs in order
#
# Params:    0 - HTML
#                1 - the original CGI input string
#                2 - pointer to the page list
#               3 - Cookie (optional)
#                4 - cache flag (optional - default no-cache)
#                5 - contact details cookie (optional)
#
#######################################################

sub UpdateDisplay
    {
#? ACTINIC::ASSERT($#_ >= 2, "Invalid argument count in UpdateDisplay ($#_)", __LINE__, __FILE__);
    my ($sHTML, $OriginalInputData, $pPageList, $sCookie, $bNoCacheFlag, $sContactDetailsCookie) = @_;
    if (!defined $sCookie)                                # if the optional cookie was not supplied
        {
        $sCookie = '';                                        # set the cookie to empty
        }
    if (!defined $bNoCacheFlag)                        # default the cache flag to no cache
        {
        $bNoCacheFlag = $::TRUE;
        }

    ###
    # supply the page list
    ###
    my ($sSearch, $sReplace, $sPrefQuery);
    $sSearch = $::VARPREFIX."REFPAGE";

    my ($status, $sMessage, $sPrevQuery, $sPageHistory) = PrepareRefPageData($OriginalInputData, $pPageList, $::FALSE);
    if ($status != $::SUCCESS)
        {
        TerminalError($sMessage);
        }
    $sPageHistory =~ s/\|\|\|$//;                        # strip the trailing terminator
    $sReplace = "<INPUT TYPE=HIDDEN NAME=REFPAGE VALUE=\"$sPageHistory\">\n" .
    "<INPUT TYPE=HIDDEN NAME=PREVQUERY VALUE=\"$sPrevQuery\">\n"; # add the query string in case it
    # gets lost (some servers don't include it in the HTTP_REFERER)
    $sHTML =~ s/$sSearch/$sReplace/;                    # insert the page list

    #
    # add a random hidden parameter value to guarantee requeries
    #
    srand();
    my ($Random) = rand();
    $sHTML =~ s/NETQUOTEVAR:RANDOM/$Random/g;

    PrintPage($sHTML, $sCookie, $bNoCacheFlag, $sContactDetailsCookie);
    }

#######################################################
#
# PrintNonParsedHeader - print the non-parsed headers
#  Note that this function is separate from PrintHeader
#  because I didn't want to break access to PrintHeader
#  at such a late date.  This function should be called
#  when dynamic feedback is required.  Note that NT does
#  not respect nonparsed headers for dynamic update (even
#  under Apache).
#
#    Input:     0 - content type
#
#######################################################

sub PrintNonParsedHeader
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in PrintNonParsedHeader ($#_)", __LINE__, __FILE__);
    #
   # Dump the HTTP headers so we can do proper non parsed header processing (for dynamic feedback)
   #
    $|=1;
    print $::ENV{SERVER_PROTOCOL} . " 200 OK\n";
    print "Server: " . $::ENV{SERVER_SOFTWARE} . "\n";
    print "Content-type: " . $_[0] . "\n";
   #
   # Build a date for the expiry
   #
    my ($day, $month, $now, $later, $expiry, @now, $sNow);
    my (@days) = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
    my (@months) = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

    $now = time;
    @now = gmtime($now);
    $day = $days[$now[6]];
    $month = $months[$now[4]];
    $sNow = sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", $day, $now[3],
                         $month, $now[5]+1900, $now[2], $now[1], $now[0]);

    print "Date: $sNow\n\n";                            # print the date to allow the browser to compensate between server and client differences
    }

#######################################################
#
# PrintHeader - print the HTTP header
#
#    Params:     0 - content type
#                1 - content length
#                2 - cookie if any (or undef)
#                3 - no-cache flag - if $::TRUE,
#                    include no-cache flag.
#                4 - contact details cookie (optional)
#
# 3/11/99 - content type, length, date and nocache moved to the top
#        date made unconditional.    R. Zybert
#
#######################################################

sub PrintHeader
    {
#? ACTINIC::ASSERT($#_ >= 3, "Invalid argument count in PrintHeader ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($sType, $nLength, $sCookie, $bNoCache, $sContactDetailsCookie) = @_;
    #
    # Turn on non-parsed headers by default when running under IIS server and Doug MacEachern's modperl
    #
    my $bNPH = $::FALSE;
    if ( (defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/) ||
          (defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/))
        {
        $bNPH = $::TRUE;
        }

    #
    # Build a date for the expiry
    #
    my (@expires, $day, $month, $now, $later, $expiry, @now, $sNow);
    my (@days) = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
    my (@months) = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

    $now = time;
    @now = gmtime($now);
    $day = $days[$now[6]];
    $month = $months[$now[4]];
    $sNow = sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", $day, $now[3],
                            $month, $now[5]+1900, $now[2], $now[1], $now[0]);
    $later = $now + 2 * 365 * 24 * 3600;            # Time in 2 years
    @expires = gmtime($later);                            # grab time components
    $day = $days[$expires[6]];
    $month = $months[$expires[4]];
    $expiry = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT", $day, $expires[3],
                            $month, $expires[5]+1900, $expires[2], $expires[1], $expires[0]);
    #
    # set the cookie if it needs to be set
    #
    my ($sCurrentCookie) = GetCookie();
    my $bCookie = ( (length $sCookie) > 0 &&        # if a cookie is to be saved
            $sCurrentCookie ne $sCookie);                # and it is a new value
    #
    # now print the header
    #
    if ($bNPH)
        {
        print "HTTP/1.0 200 OK\n";                        # the status
        }

    print "Content-type: $sType\n";
    print "Content-length: $nLength\n";
    print "Date: $sNow\n";                            # print the date to allow the browser to compensate between server and client differences

    if ($bNoCache)
        {
        print "Pragma: no-cache\n";
        }

    if ($bCookie)                                            # if we are to save the cookie
        {
        print "Set-Cookie: ACTINIC_CART=" .            # set the cookie
           $sCookie . "; EXPIRES=" .
            $expiry . "; PATH=/;\n";
        }

    if ($sContactDetailsCookie)                        # if we are to save the contact details cookie
        {
        print "Set-Cookie: " . $sContactDetailsCookie . # set the cookie
           "; EXPIRES=" . $expiry . "; PATH=/;\n";
        }

    if ($::ACT_ADB)                                # If there is an address book
        {
        print $::ACT_ADB->Header();            # Ouput address book cookies
        }

    my $sDigest = $ACTINIC::B2B->Get('UserIDCookie');                                        # If B2B user logged in - save the digest
    if ( $sDigest )
        {
        if ( $sDigest eq "." )
            {
            $sDigest = "";
            }
        print "Set-Cookie: ACTINIC_ACCOUNT=" . $sDigest .         # set the cookie - this session only
           "; PATH=/;\n";
        }
    else
        {
        if ( $ACTINIC::B2B->Get('ClearIDCookie') )
            {
            print "Set-Cookie: ACTINIC_ACCOUNT=; PATH=/;\n";         # Clear ID cookie
            }
        if ( $ACTINIC::B2B->Get('ClearUserCookie') )
            {
            print "Set-Cookie: ACTINIC_USERNAME=; PATH=/;\n";         # Clear username  cookie
            }
        }
    if ($ACTINIC::B2B->Get('BaseFileCookie'))                                            # If B2B user logged in - save the base file address
        {
        print "Set-Cookie: ACTINIC_BASEFILE=" . $ACTINIC::B2B->Get('BaseFileCookie') .    # set the cookie - this session only
           "; PATH=/;\n";
        }
    if ($ACTINIC::B2B->Get('UserNameCookie'))                                            # If B2B user logged in - save user name
        {
        print "Set-Cookie: ACTINIC_USERNAME=" . $ACTINIC::B2B->Get('UserNameCookie') .    # set the cookie - this session only
           "; PATH=/;\n";
        }
    if ($ACTINIC::B2B->Get('ProductFileCookie'))                                        # If B2B user logged in - ssve PRODUCTPAGE
        {
        print "Set-Cookie: ACTINIC_PRODUCTPAGE=" . $ACTINIC::B2B->Get('ProductFileCookie') .    # set the cookie - this session only
           "; PATH=/;\n";
        }


    print "\n";
    }

#######################################################
#
# PrintPage - print the HTML page
#
#    Params:     0 - HTML to print
#                1 - cookie if any (or undef)
#                2 - no-cache flag - if $::TRUE,
#                    include no-cache flag.
#                    Default - $::TRUE
#                3 - contact details cookie (optional)
#
#######################################################

sub PrintPage
    {
#? ACTINIC::ASSERT($#_ >= 1, "Invalid argument count in PrintPage ($#_)", __LINE__, __FILE__);
   if ($::s_nErrorRecursionCounter > 10)
        {
        $ACTINIC::AssertIsActive = $::TRUE;
#?      ACTINIC::TRACE('Callstack:\n%s', CallStack());
        }
   $::s_nErrorRecursionCounter++;

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($nLength, $sHTML, $sCookie, $bNoCacheFlag, $sContactDetailsCookie);
    ($sHTML, $sCookie, $bNoCacheFlag, $sContactDetailsCookie) = @_;

   if (!$ACTINIC::AssertIsActive)                     # skip the XML parsing if we are reporting an assert as this can cause infinite looping if the problem is in the customer account code
        {
        $sHTML = ACTINIC::ParseXML($sHTML);            # the body
        }
    $nLength = length $sHTML;

    if (!defined $bNoCacheFlag)                        # default the no cache flag to on
        {
        $bNoCacheFlag = $::TRUE;
        }

    PrintHeader('text/html', $nLength, $sCookie, $bNoCacheFlag, $sContactDetailsCookie);

    binmode STDOUT;                                        # dump in binary mode since Netscape likes it

    print $sHTML;                            # the body
    }

#######################################################
#
# PrintText - print the text page
#
#    Params:     0 - text to print
#
#######################################################

sub PrintText
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in PrintText ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my $sText = $_[0];

    my $nLength = length $sText;

    PrintHeader('text/plain', $nLength, undef, $::FALSE);

    binmode STDOUT;                                        # dump in binary mode since Netscape likes it

    print $sText;                                            # the body
    }

#######################################################
#
# ReportError - report the specified error to the
#    browser and error file
#
# Params:    0 - error message
#                1 - the file path
#
#######################################################

sub ReportError
    {
#? ACTINIC::ASSERT($#_ == 1, "Invalid argument count in ReportError ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($sMessage, $sPath);
    ($sMessage, $sPath) = @_;

    RecordErrors(@_);                                        # record the error to the error file

    TerminalError($_[0]);                                # display the error
    }

#######################################################
#
# RecordErrors - Record the specified error to the
#    error file
#
# Params:    0 - error message
#                1 - file path
#
#######################################################

sub RecordErrors
    {
#? ACTINIC::ASSERT($#_ == 1, "Invalid argument count in RecordErrors ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($sMessage, $sPath);
    ($sMessage, $sPath) = @_;

    #########
    # Write the error to the file
    #########
    my ($sPad, $sFormat, $sFile);
    $sPad = " "x100;
    $sFile = $sPath."error.err";

    SecurePath($sFile);                                    # make sure only valid filename characters exist in $file to prevent hanky panky

    open(NQFILE, ">>".$sFile);                            # Open the error file

    print NQFILE ("Program = ");                        # Begin to write error file details
    print NQFILE (substr($::prog_name.$sPad,0,8)); # Write error file details

    print NQFILE (", Program version = ");            # Write error file details
    print NQFILE (substr($::prog_ver.$sPad,0,6)); # Write error file details

    print NQFILE (", HTTP Server = ");                # Write error file details
    print NQFILE (substr($::ENV{'SERVER_SOFTWARE'}.$sPad,0,30)); # Write error file details

    print NQFILE (", Return code = ");                # Write error file details
    print NQFILE (substr("999".$sPad,0,20));        # Write error file details

    print NQFILE (", Date and Time = ");            # Write error file details

    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);    # platform independent time
    $mon++;                                                    # make month 1 based
    $year += 1900;                                            # make year AD based
    $sFormat = sprintf("%2.2d/%2.2d/%4.4d %2.2d:%2.2d:%2.2d", $mday, $mon, $year, $hour, $min, $sec);
    print NQFILE ($sFormat);                            # Write error file details

    print NQFILE (", Internal Errors = ");            # Write error file details
    print NQFILE ($sMessage);                            # Write error file details

    print NQFILE "\n";
    close NQFILE;

    ChangeAccess("rw", $sFile);                        # make the file accessible
    }

#######################################################
#
# TerminalError - generate the error html
#
#    Params:     0 - the error
#
#######################################################

sub TerminalError
    {
# No assert here because the assert function calls this function - recursion loop
    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($sError, $sHTML);
    ($sError) = @_;                                        # get the error message

    $sHTML  = "<HTML><TITLE>Actinic</TITLE><BODY>";
    if (defined $::g_pPromptList)
        {
        $sHTML .= "<H1>" . GetPhrase(-1, 24) . "</H1>";
        $sHTML .= "<HR>" . GetPhrase(-1, 25) . ": $sError<HR>";
        $sHTML .= GetPhrase(-1, 26);
        }
    else                                                        # if the localized text file has not been read - assume english
        {
        $sHTML .= "<H1>" . "A General Script Error Occurred" . "</H1>";
        $sHTML .= "<HR>" . "Error" . ": $sError<HR>";
        $sHTML .= "Press the Browser back button and try again or contact your ISP.";
        }
    $sHTML .= "</BODY></HTML>";

    $ACTINIC::AssertIsActive = $::TRUE;
    PrintPage($sHTML, undef, $::TRUE);

    exit;
    }

#######################################################
#
# MakeLinksAbsolute - make all file references
#    absolute (to the web site dir)
#
# Params:    0 - current HTML
#                1 - referring site url
#                2 - content url
#
# Returns:    0 - status
#                1 - error message
#                2 - modified text
#
# 3/11/99 - modified to accept single quotes - R. Zybert
#
#######################################################

sub MakeLinksAbsolute
    {
#? ACTINIC::ASSERT($#_ == 2, "Invalid argument count in MakeLinksAbsolute ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #
    my ($sHTML, $sWebSiteUrl, $sContentUrl, $Status, $Message, @Response);
    ($sHTML, $sWebSiteUrl, $sContentUrl) = @_;

    $sContentUrl =~ s#/[^/]*$#/#;

    #######
    # make the file references point to the correct directory
    # Absolute addresses (starting from /) are unchanged (rz)
    #######
    $sHTML =~ s/<IMG([^>]*?)SRC=(['"])?(?!http(s?):)([^'"\/][^"\s]+)(['"\s])/<IMG$1SRC=$2$sContentUrl$3$4$5/gi;    # '<emacs format> # replace image file references
    $sHTML =~ s/<BODY([^>]*?)BACKGROUND=(['"])?(?!http(s?):)([^'"\/][^'"\s]+)(['"\s])/<BODY$1BACKGROUND=$2$sContentUrl$3$4$5/gi;    # ' <quote helps emacs format> # replace background imagefile refs
    $sHTML =~ s/CODEBASE=(['"])?(?!http(s?):)([^'"\/][^"\s]+)(['"\s])/CODEBASE=$1$sContentUrl$2$3$4/gi;    # ' <quote helps emacs format> # replace codebase references
    $sHTML =~ s/\.src\s*=\s*(['"])(?!http(s?):)([^'"\/][^"'\s]+)(["'])/\.src = $1$sContentUrl$2$3$4/gi;    # ' <quote helps emacs format> # replace javascript images
      $sHTML =~ s/<A([^>]*?)HREF=(['"])?(?!http(s?):|mailto:|#|\/|javascript:)([^'"\s]+)(['"\s])/<A$1HREF=$2$sWebSiteUrl$3$4$5/gi;    # " <quote helps emacs format> # replace hyperlink references
     $sHTML =~ s/<FRAME([^>]*?)SRC=(['"])?(?!http(s?):|mailto:|#)([^'"\/][^'"\s]+)(["\s])/<FRAME$1SRC=$2$sWebSiteUrl$3$4$5/gi;    # " <quote helps emacs format> # replace hyperlink references
#     $sHTML =~ s/<FRAME([^>]*?)SRC=(['"])?([^'"][^'"]+)(["'])/<FRAME$1SRC=$2$sWebSiteUrl$2$3$4/gi;    # Simpler frame format
    $sHTML =~ s/<INPUT([^>]*?)SRC=(['"])?(?!http(s?):)([^'"\/][^'"\s]+)(["\s])/<INPUT$1SRC=$2$sContentUrl$3$4$5/gi;    # " <quote helps emacs format> # replace image file references
    return ($::SUCCESS, '', $sHTML);                    # do the replacement
    }
##################################################################################
#                                                                                                            #
# HTML manipulation functions - end                                                                #
#                                                                                                            #
##################################################################################

##################################################################################
#                                                                                                            #
# Generic Utilities - begin                                                                        #
#                                                                                                            #
##################################################################################

#######################################################
#
# GetScriptNameRegexp
#
# Returns:     0 - a regexp that will match any of the
#                    standard Catalog scriptnames
#
#######################################################

sub GetScriptNameRegexp
    {
    my (@ScriptPathParts) = split /(\\|\/)/, $::ENV{"SCRIPT_NAME"};
    my ($sScriptBase);
    $sScriptBase = substr($ScriptPathParts[$#ScriptPathParts], 2);
    return ("(ca|os|nq|ts|cp|ss|sh|bb|md)$sScriptBase");
    }

############################################################
#  IsStaticPage
#  Test URL to guess if it represents a static page
#
#   Argument : URL
#   Result   : $::TRUE for static page
#                 $::FALSE if not (or don't know)
#
#  Ryszard Zybert  Jul 24 20:32:07 BST 2000
#
#  Copyright (c) Actinic Software Ltd (2000)
############################################################
sub IsStaticPage
    {
    my ($sURL) = @_;
    my $sRegExp = GetScriptNameRegexp();
    if( $sURL =~ /(\.htm(l?)(\#[^\#]*)*)|(\/)$/i and $sURL !~ /$sRegExp/ )
        {
        return ($::TRUE);
        }
    return ($::FALSE);
    }
#######################################################
#
# Modulus - use this division function in place of
#    the % operator in cases where performance is not an
#    issue *or* when it is likely that the number is
#    greater than 2^31.  This is required because Perl
#    5.003 on FreeBSD crashes with a floating point exception
#    in those cases.
#
# Params:    0 - a
#                1 - b
#        where c = a % b
#
# Returns:     0 - c
#
#######################################################

sub Modulus
    {
#? ACTINIC::ASSERT($#_ == 1, "Wrong number of arguments in Modulus ($#_)", __LINE__, __FILE__);
    my ($nA, $nB) = @_;
    #
    # a % b = int(a - b * int(a/b) )
    #
    my $nC = $nA - $nB * int($nA / $nB);
#?    if ($^O ne 'freebsd')
#?        {
#?        my $nD = $nA % $nB;
#? ACTINIC::ASSERT($nD == $nC, "Modulus emulation error $nC != $nD", __LINE__, __FILE__);
#?        }
    return($nC);
    }

#######################################################
#
# ReadTheDir
#     Open a directory and read its contents - this
#     is a hack-around for a bug in PerlIS for NT.
#
# Params:     0 - the directory path to read
#
# Returns:     0 - status code
#                1 - error message if any
#                2+ - file list (or 0, 0)
#
#######################################################

sub ReadTheDir
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ReadTheDir ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($sPath, @FileList);
    ($sPath) = @_;                                            # get the path

    SecurePath($sPath);                                    # make sure only valid filename characters exist in $file to prevent hanky panky
    if( opendir (NQDIR, "$sPath") )                    # open the directory to get a file listing
        {                                                        # if successful,
        @FileList = readdir (NQDIR);                    # read the directory
        closedir (NQDIR);                                    # close the directory
        return ($::SUCCESS, '', @FileList);            # return the directory contents
        }

    if ($^O ne "MSWin32")
        {
        return($::FAILURE, GetPhrase(-1, 31, $sPath, $!), 0, 0);
        }
    #
    # if we are here, the open failed.  This is probably NT with the PerliS 303 bug
    #    try to read the directory using dos commands
    #
    my ($sDosPath, $sCommand);
    $sDosPath = $sPath;                                    # get the path of the directory to read
    $sDosPath =~ s/\//\\/g;                                # convert the forward slashes to dos backslashes

    $sCommand = "dir /B \"$sDosPath\"";

    unless (open (PIPE, $sCommand . " |"))
        {
        return($::FAILURE, GetPhrase(-1, 32, $sPath, $!), 0, 0);
        }

    @FileList = <PIPE>;                                    # read the contents of the directory
    chomp @FileList;                                        # remove the trailing newlines
    close (PIPE);                                            # close the file

    if ($#FileList == 0 &&                                # if the command returned file not found
         $FileList[0] =~ m/File Not Found/i)
        {
        my ($sMessage);
        $sMessage = $FileList[0];
        return($::FAILURE, GetPhrase(-1, 32, $sPath, $sMessage), 0, 0);
        }

    return ($::SUCCESS, '', @FileList);                # return the directory contents
    }

#######################################################
#
# IsCatalogFramed - Is Catalog running in framed mode
#
# Returns:    ($ReturnCode)
#                $::TRUE if running in a Frame
#                $::FALSE if not
#
#######################################################

sub IsCatalogFramed
    {
    #
    # use the existence of navigation page
    #
    return(CheckFileExists("framenavbar.html", GetPath()));
    }

#######################################################
#
# CheckFileExists - returns whether the given file
#                exists and is readable
#
# Params:    [0] - File name
#                [1] - Path
#
# Returns:    ($ReturnCode)
#                $::TRUE if file exists and is readable
#                $::FALSE if not
#
#######################################################

sub CheckFileExists
    {
#? ACTINIC::ASSERT($#_ == 1, "Wrong number of arguments in CheckFileExists", __LINE__, __FILE__);

    my ($sFileName, $sPath);
    ($sFileName, $sPath) = @_;
    #
    # build the file name
    #
    my $sFile = $sPath . $sFileName;
    return (-e $sFile && -r $sFile);                    # does the file exist and is readable
    }

#######################################################
#
# GetCatalogBasePageName - gets the file name of the
#        enclosing frame
#
# Params:    [0] - Path
#
# Returns:    ($ReturnCode, $sError, $sPageName)
#                $::TRUE if file exists and is readable, $::FALSE if not
#                $sError if present or ""
#                $sBasePageName - base page name
#
#######################################################

sub GetCatalogBasePageName
    {
#? ACTINIC::ASSERT($#_ == 0, "Wrong number of arguments in GetCatalogBasePageName", __LINE__, __FILE__);

    my ($sPath, $sBasePageName, $sNavFileName);
    ($sPath) = @_;
    #
    # build the file name
    #
    my $sFile = "framenavbar.html";
    if(!CheckFileExists($sFile, $sPath))
        {
        return($::FALSE, "$sFile could not be found", "");
        }
    $sNavFileName = $sPath . $sFile;
    #
    # open the file
    #
    unless (open (NAVFILE, "<$sNavFileName"))
        {
        return ($::FALSE, ACTINIC::GetPhrase(-1, 21, $sNavFileName, $!), '');
        }
    #
    # find a HTML fragment with the base page name
    #
        {
        local $/ = undef;
        $_ = <NAVFILE>;                                    # read the entire file into $_

        ($sBasePageName) = /\&BPN=([a-zA-Z0-9_.]+)[^>]*?TARGET="_(top|parent)"/i;
#? ACTINIC::ASSERT((length $sBasePageName) > 0, "Base page name not found", __LINE__, __FILE__);
        }
    close(NAVFILE);
    return ($::SUCCESS, "", $sBasePageName);        # return our base page name
    }

##################################################################################
#                                                                                                            #
# Generic Utilities - end                                                                        #
#                                                                                                            #
##################################################################################

##############################################################################################################
#
# CGI Input Processing (should use CGI.pm but forbidden)- Begin
#
##############################################################################################################

#######################################################
#
# ReadAndParseInput - read the input and parse it
#
# Expects:    $::ENV to be defined
#
# Returns:    0 - status
#                1 - error message
#                2 - the input string
#                3 - spacer to keep output even
#                4+ - input hash table
#
#######################################################

sub ReadAndParseInput
    {
    my ($InputData, $nInputLength);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    if ( (length $::ENV{'QUERY_STRING'}) > 0)        # if there is query string data (GET)
        {
        $InputData = $::ENV{'QUERY_STRING'};        # read it
        $nInputLength = length $InputData;
        }
    else                                                        # otherwise, there must be a POST
        {
        my ($nStep, $InputBuffer);
        $nInputLength = 0;
        $nStep = 0;
        while ($nInputLength != $ENV{'CONTENT_LENGTH'})    # read until you have the entire chunk of data
            {
            #
            # read the input
            #
            binmode STDIN;
            $nStep = read(STDIN, $InputBuffer, $ENV{'CONTENT_LENGTH'});  # Set $::g_InputData equal to user input
            $nInputLength += $nStep;                    # keep track of the total data length
            $InputData .= $InputBuffer;                # append the latest chunk to the total data buffer
            if (0 == $nStep)                                # EOF
                {
                last;                                            # stop read
                }
            }

        if ($nInputLength != $ENV{'CONTENT_LENGTH'})
            {
            return ($::FAILURE, "Bad input.  The data length actually read ($nInputLength) does not match the length specified " . $ENV{'CONTENT_LENGTH'} . "\n", '', '', 0, 0);
            }
        }
    $InputData =~ s/&$//;                                # loose any bogus trailing &'s
    $InputData =~ s/=$/= /;                                # make sure trailing ='s have a value
    my ($OriginalInputData);
    $OriginalInputData = $InputData;                    # copy the input string for use later

    if ($nInputLength == 0)                                # error if there was no input
        {
        return ($::FAILURE, "The input is NULL", '', '', 0, 0);
        }
    #
    # parse and decode the input
    #
    my (@CheckData, %DecodedInput);
    @CheckData = split (/[&=]/, $InputData);        # check the input line
    if ($#CheckData % 2 != 1)
        {
        return ($::FAILURE, "Bad input string \"" . $InputData . "\".  Argument count " . $#CheckData . ".\n", '', '', 0, 0);
        }
    my %EncodedInput = split(/[&=]/, $InputData);    # parse the input hash
    my ($key, $value);
    while (($key, $value) = each %EncodedInput)
        {
        $key = DecodeText($key, $ACTINIC::FORM_URL_ENCODED);    # decode the hash entry
        $value = DecodeText($value, $ACTINIC::FORM_URL_ENCODED);
        if ($key !~ /BLOB/i &&                            # if the input is not an order blob
             ($key =~ /\0/ ||                                # check for poison NULLs
              $value =~ /\0/))
            {
            return ($::FAILURE, "Input contains invalid characters.", undef, undef, undef, undef);
            }

        $DecodedInput{$key} = $value;
        }
    #
    # Now process the path to the catalog directory.  In stand alone mode, the path is hard coded in the script.
    # In Actinic Host mode, the path is derived from the SHOPID and the shop data file.
    #
    my ($status, $sError) = ProcessPath($DecodedInput{SHOP}, \%DecodedInput);
    if ($status != $::SUCCESS)
        {
        return ($status, $sError);
        }

    return ($::SUCCESS, '', $OriginalInputData, '', %DecodedInput);
    }

#######################################################
#
# ProcessPath - process the input to derive a path
#   to the catalog directory
#
# Params:    0 - shop ID if in Actinic Host Mode
#               or undef if stand alone
#
# Returns:    0 - status
#                1 - error message
#
#######################################################

sub ProcessPath
    {
#? ACTINIC::ASSERT($#_ >= 0, "Invalid argument count in ProcessPath ($#_)", __LINE__, __FILE__);
    my ($sShopID, $rhInput) = @_;
    my ($status, $sError);
    #
    # Now process the path to the catalog directory.  In stand alone mode, the path is hard coded in the script.
    # In Actinic Host mode, the path is derived from the SHOPID and the shop data file.
    #
    my $sInitialPath = 'NETQUOTEVAR:PATH';
    if (!NETQUOTEVAR:ACTINICHOSTMODE)                # stand alone mode
        {
        $ACTINIC::s_sPath = $sInitialPath;
        }
    else
        {
        #
        # Check if the shop ID has nothing in it
        #
        if ($sShopID eq '' &&
            ($$rhInput{ACTION} eq 'AUTHORIZE' || $$rhInput{ACTION} eq 'OCC_VALIDATE'))
            {
            if(defined $$rhInput{PATH} && $$rhInput{PATH} ne '')
                {
                $ACTINIC::s_sPath = $$rhInput{PATH};
                return ($::SUCCESS, undef);
                }
            }
        #
        # Load the module for access to the configuration files
        #
        eval 'require MallUtil;';
        if ($@)                                                # the interface module does not exist
            {
            return ($::FAILURE, 'An error occurred loading the MallUtil module.  ' . $@);
            }
        #
        # Retrieve the appropriate record
        #
        my $pShop;
        ($status, $sError) = MallUtil::GetShopRecordFromShopID($sShopID, \$pShop);
        if ($status != $::SUCCESS)
            {
            return ($status, $sError);
            }
        #
        # Retrieve the specific path
        #
        $ACTINIC::s_sPath = $pShop->{PATH};
        }

    return ($::SUCCESS, undef);
    }

#######################################################
#
# ProcessReferencePageData - keep track of the
#    reference page data
#
# Params:    0+ - InputHash
#
# Returns:    0 - status
#                1 - error message
#                2+ - page list
#
#######################################################

sub ProcessReferencePageData
    {
#? ACTINIC::ASSERT($#_ > 0, "Invalid argument count in ProcessReferencePageData ($#_)", __LINE__, __FILE__);

    my (%InputHash);
    (%InputHash) = @_;

    my ($sPages, @PageList);
    $sPages = $InputHash{"REFPAGE"};                    # read the pagelist from the params
    if (defined $sPages)
        {
        @PageList = split (/\|\|\|/, $sPages);        # parse the list
        }
    else
        {
        @PageList = ();
        }

#    if ($#PageList != -1 &&                                # if there are any entries and
    if ($#PageList > 0 &&                                # if there are any entries (not just END) and
         $PageList[$#PageList] eq "END")                # this was a page bounce
        {
        pop @PageList;                                        # drop the terminating "END" and don't add the bounce page to the
        }                                                        # history list
    else
        {
        my ($sRefPage);
        $sRefPage = GetReferrer();
        ($sRefPage) = split (/\&REFPAGE/, $sRefPage); # drop any refpage information from the referring page - we track that

        my ($sTopTag);
        $sTopTag = '#top';                                # the top flag sometimes causes problems, so make sure it
        $sRefPage =~ s/$sTopTag//g;                    # is stripped
        #
        # correct the referring page if we are using frames to make this CGI call and the call came
        # from the navigation bar.
        #
        if ($InputHash{BPN} ne '')                        # this call was made from the navigation frame
            {
            my $nIndex;
            #
            # strip the filename from the static page URL
            #
            while ($sRefPage =~ /\//g)
                {
                $nIndex = pos $sRefPage;                # locate the last "/"
                }
            $sRefPage = substr ($sRefPage, 0, $nIndex);    # snag the url
            #
            # cat on the base page filename
            #
            $sRefPage .= $InputHash{BPN};
            }

        push (@PageList, $sRefPage);                    # add the last page to the list
        }

    #####
    # make sure any CGI queries in the ref page list include their query_string
    #####
    my ($sScriptName) = GetScriptNameRegexp();
    if ($PageList[$#PageList] =~ /$sScriptName$/)# if the refpage indicates there is a script in the list that does
        {                                                        # not have its query string,
        $PageList[$#PageList] .= "?" . $InputHash{'PREVQUERY'};          # add the query string
        }

    return ($::SUCCESS, '', @PageList);
    }

#######################################################
#
# GetWebSiteURL - get the web site URL from the pagelist
#
# Params:    0+ - PageList
#
# Returns:    0 - status
#                1 - error message
#                2 - the URL of the directory of the referring
#                    document.  Relative links refer to this
#                    directory, and CGI calls should return
#                    the customer to this directory.
#                3 - URL of content directory.
#                    3 is usually identical to 2, but in the
#                    case of SSL, 2 is insecure and 3 is secure.
#                    in the future, we could expand 3 to actually
#                    refer to a different server.
#
#######################################################

sub GetWebSiteURL
    {
#? ACTINIC::ASSERT($#_ >= 0, "Invalid argument count in GetWebSiteUrl ($#_)", __LINE__, __FILE__);

    my (@PageList);
    (@PageList) = @_;

    if ($#PageList == -1)
        {
        my ($sDigest,$sBaseFile) = ACTINIC::CaccGetCookies();        # See if the user logged in
        if( !$sBaseFile )
            {
            return ($::FAILURE, "Unable to retrieve web site URL from NULL page list", '', 0);
            }
        else
            {
            $PageList[0] = $sBaseFile;
            }
        }

    #######
    # retrieve the web site url
    #######
    my ($nIndex, $sTemp, $sReferenceUrl);
    $sTemp = $PageList[0];                                # get the primary reference page
    while ($sTemp =~ /\//g)
        {
        $nIndex = pos $sTemp;                            # locate the last "/"
        }
    $sReferenceUrl = substr ($sTemp, 0, $nIndex);    # snag the url

    my $sContentUrl = $sReferenceUrl;

    if ($sContentUrl &&                                    # if the web site url has been defined and
        $$::g_pSetupBlob{USE_SSL})                        # we are using SSL security
        {
        $sContentUrl =~ s/http:\/\//https:\/\//i;    # make the images, etc. use secure transfer
        }

    return ($::SUCCESS, '', $sReferenceUrl, $sContentUrl);
    }

#######################################################
#
# PrepareRefPageData - prepare the ref page data for
#    insertion into HTML
#
# Params:    0 - original input data
#                1 - pointer to the page list
#                2 - encode flag - If $::TRUE, encode the
#                        components of the refpage string
#                        before returning it
#
# Returns:    0 - status
#                1 - error message
#                2 - previous query string
#                3 - refpage string
#
#######################################################

sub PrepareRefPageData
    {
#? ASSERT($#_ == 2, "Incorrect parameter count in PrepareRefPageData", __LINE__, __FILE__);

    my ($sPrevQuery, $pPageList, $bEncode) = @_;
    ($sPrevQuery) = split (/\&REFPAGE/, $sPrevQuery); # drop any refpage information from the previous query - tracked sep
    #
    # encode the ref page list
    #
    my $sHistoryElement;
    my $sRefPageList;
    if ($bEncode)
        {
        foreach $sHistoryElement (@$pPageList)
            {
            my @Response = EncodeText($sHistoryElement, $::FALSE);
            $sRefPageList .= $Response[1] . '|||';
            }
        }
    else
        {
        $sRefPageList = join('|||', @$pPageList);
        $sRefPageList .= '|||';
        }
    return ($::SUCCESS, '', $sPrevQuery, $sRefPageList);
    }

##############################################################################################################
#
# CGI Input Processing (should use CGI.pm but forbidden)- End
#
##############################################################################################################

##############################################################################################################
#
# File Read Calls - Begin
#
##############################################################################################################

#######################################################
#
# GetSectionBlobName - make the blob name from the ID
#
# Input:    0 - section ID
#
# Returns:    0 - return code ($::SUCCESS or $::FAILURE)
#           1 - error message (if any)
#                2 - blob name
#
#######################################################

sub GetSectionBlobName
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in GetSectionBlobName ($#_)", __LINE__, __FILE__);
    #
    # Validate the input ID - make sure it contains only digits
    #
    if ($_[0] !~ /^(\d+)$/)                                # if the section ID does not contain only digits
        {
        return ($::FAILURE, GetPhrase(-1, 306));        # bad input
        }
    my $nID = $1;                                            # retrieve the ID

    return ($::SUCCESS, undef, sprintf('A000%d.cat', $nID));    # format and return the filename
    }

#######################################################
#
# GetProduct - locate a product object given its
#    product reference.  if the queried product has
#    been removed from the catalog, GetProduct will
#    return NOTFOUND.
#
# Params:    0 - the product reference
#                1 - the section blob filename
#                2 - file path
#
# Returns:    0 - status (SUCCESS, FAILURE, NOTFOUND)
#                1 - error message
#                2 - a reference to the product
#
#######################################################

sub GetProduct
    {
#? ACTINIC::ASSERT($#_ == 2, "Invalid argument count in GetProduct ($#_)", __LINE__, __FILE__);

    my ($ProductRef, $sSectionBlobFilename, $sPath);
    ($ProductRef, $sSectionBlobFilename, $sPath) = @_;
    if (length $ProductRef == 0)
        {
        return ($::FAILURE, GetPhrase(-1, 37), 0, 0);
        }
    #
    # see if the section is already in memory
    #
    my ($bInMemory);
    $bInMemory = defined $::g_pSectionList{$sSectionBlobFilename};

    #
    # If the item is not in memory, read the section blob
    #
    my (@Response, $Status, $Message);
    if (!$bInMemory)
        {
        @Response = ReadSectionFile($sPath.$sSectionBlobFilename);
        ($Status, $Message) = @Response;
        if ($Status != $::SUCCESS)
            {
            return ($::NOTFOUND, GetPhrase(-1, 173, $ProductRef), \%::g_DeletedProduct);
            }
        my $nVersion = 10;
        if (${$::g_pSectionList{$sSectionBlobFilename}}{VERSION} != $nVersion)        # not the correct blob version number
            {
            return ($::FAILURE, "Section blob version is " . ${$::g_pSectionList{$sSectionBlobFilename}}{VERSION} .
              ", but only version $nVersion is supported.  File: $sSectionBlobFilename", 0, 0);
            }
        }
    #
    # see if the product was found in the file.  If not, the supplier must have removed the item from the
    # catalog after we added the item to the cart.
    #

    if (!defined ${$::g_pSectionList{$sSectionBlobFilename}}{$ProductRef})
        {
        return ($::NOTFOUND, GetPhrase(-1, 173, $ProductRef), \%::g_DeletedProduct);
        }

    return ($::SUCCESS, '', ${$::g_pSectionList{$sSectionBlobFilename}}{$ProductRef});
    }

#######################################################
#
# GetProductReferenceFromVariant - translate the
#    specified product variant code into a product
#    reference.
#
# Params:    0 - the variant code
#                1 - the section blob filename
#                2 - file path
#
# Returns:    0 - status (SUCCESS, FAILURE, NOTFOUND)
#                1 - error message
#                2 - the product reference
#
#######################################################

sub GetProductReferenceFromVariant
    {
#? ACTINIC::ASSERT($#_ == 2, "Invalid argument count in GetProductReferenceFromVariant ($#_)", __LINE__, __FILE__);
    my ($sInvalidProductReference) = "'";
    my ($sVariantCode, $sSectionBlobFilename, $sPath);
    ($sVariantCode, $sSectionBlobFilename, $sPath) = @_;
#? ACTINIC::ASSERT(length $sVariantCode > 0, "Invalid product variant code (empty).", __LINE__, __FILE__);
    #
    # see if the section is already in memory
    #
    my ($bInMemory);
    $bInMemory = defined $::g_pVariantList{$sSectionBlobFilename};
    #
    # If the item is not in memory, read the section blob
    #
    my (@Response, $Status, $Message);
    if (!$bInMemory)
        {
        @Response = ReadSectionFile($sPath.$sSectionBlobFilename);
        ($Status, $Message) = @Response;
        if ($Status != $::SUCCESS)
            {
            return (@Response);
            }
        my $nVersion = 0;
        if (${$::g_pVariantList{$sSectionBlobFilename}}{VERSION} != $nVersion)    # not the correct blob version number
            {
            return ($::FAILURE, "Variant blob version is " . ${$::g_pVariantList{$sSectionBlobFilename}}{VERSION} .
                ", but only version $nVersion is supported.  File: $sSectionBlobFilename", 0, 0);
            }
        }
    #
    # see if the product was found in the file.  If not, the supplier must have removed the item from the
    # catalog after we added the item to the cart.
    #
    if (!defined ${$::g_pVariantList{$sSectionBlobFilename}}{$sVariantCode})
        {
        return ($::FAILURE, GetPhrase(-1, 190, $sVariantCode), $sInvalidProductReference);
        }

    return ($::SUCCESS, undef, ${$::g_pVariantList{$sSectionBlobFilename}}{$sVariantCode});
    }

#######################################################
#
# ReadSetupFile - read the setup blob file
#
# Params:    0 - path
#
# Returns:    0 - status
#                1 - error message
#
# Affects:    $::g_pSetupBlob - points to the global
#                    setup hash
#
#######################################################

sub ReadSetupFile
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ReadSetupFile ($#_)", __LINE__, __FILE__);

    my @Response = ReadConfigurationFile($_[0]."nqset00.fil",'$g_pSetupBlob');    # load the catalog
    if ($Response[0] != $::SUCCESS)
        {
        return (@Response);
        }

    my $nSetupVersion = 23;
    if ($$::g_pSetupBlob{VERSION} != $nSetupVersion) # not the correct blob version number
        {
        return ($::FAILURE, "Setup blob version is " . $$::g_pSetupBlob{VERSION} .
            ", but only version $nSetupVersion is supported.", 0, 0);
        }
    my $nMinorVersion = 1;
    if ($$::g_pSetupBlob{MINOR_VERSION} < $nMinorVersion) # not the correct blob version number
        {
        return ($::FAILURE, "Setup blob minor version number is " . $$::g_pSetupBlob{MINOR_VERSION} .
            ", but minor version $nMinorVersion is required.", 0, 0);
        }
#? if ($$::g_pSetupBlob{MINOR_VERSION} > $nMinorVersion)
#?        {
#?        TRACE('Setup blob minor version number does not match the script minor version number.');
#?        TRACE("\tThe setup blob minor version number is " . '%d.', $$::g_pSetupBlob{MINOR_VERSION});
#?        TRACE("\tThe script expects minor version number " . '%d.', $nMinorVersion);
#?        }

    $::g_sRequiredColor    = $$::g_pSetupBlob{REQUIRED_COLOR}; # store the global required field color

    if ($::g_sContentUrl &&                                # if the web site url has been defined and
        $$::g_pSetupBlob{USE_SSL})                        # we are using SSL security
        {
        $::g_sContentUrl =~ s/http:\/\//https:\/\//i;    # make the images, etc. use secure transfer
        }

    $::g_sAccountScript = $$::g_pSetupBlob{CGI_URL};                # Full HTTP path to account script
    $::g_sAccountScript .= sprintf("bb%6.6d%s",$$::g_pSetupBlob{CGI_ID},$$::g_pSetupBlob{CGI_EXT});
    if( $$::g_pSetupBlob{USE_SSL} )
        {
        $::g_sAccountScript =~ s/http:\/\//https:\/\//i;    # make the script use SSL
        }

    # PRESNET
    # Presnet: set flags by uncommenting these changes
    #
#    $$::g_pSetupBlob{'EMAIL_ORDER'}    = $::TRUE;
#    $$::g_pSetupBlob{'REVERSE_ADDRESS_CHECK'}    = $::TRUE;
#    $$::g_pSetupBlob{'SUPPRESS_CART_WITH_CONFIRM'}    = $::TRUE;
#    $$::g_pSetupBlob{'DISPLAY_CART_AFTER_CONFIRM'}    = $::TRUE;
#    $$::g_pSetupBlob{'PROCEED_CHECKOUT'} = 'pwc.gif';
#    $$::g_pSetupBlob{'CONTINUE_SHOP'} = 'cs.gif';
#    $$::g_pSetupBlob{'EDIT_CART'} = 'ec.gif';
#    $$::g_pSetupBlob{'CONFIRM_IMG'} = 'cnfm.gif';
#    $$::g_pSetupBlob{'CANCEL_IMG'} = 'can.gif';
#    $$::g_pSetupBlob{'REMOVE_IMG'} = 'rem.gif';
#    $$::g_pSetupBlob{'EDIT_IMG'} = 'edit.gif';
    # PRESNET

    return ($::SUCCESS, "", 0, 0);                    # we are done
    }

#######################################################
#
# ReadCatalogFile - read the catalog blob file.
#
# Params:    0 - path
#
# Returns:    0 - status
#                1 - error message
#
# Affects:    $::g_pCatalogBlob - points to the global
#                    catalog hash
#
#######################################################

sub ReadCatalogFile
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ReadCatalogFile ($#_)", __LINE__, __FILE__);

    my @Response = ReadConfigurationFile($_[0]."A000.cat",'$g_pCatalogBlob');    # load the catalog
    if ($Response[0] != $::SUCCESS)
        {
        return (@Response);
        }

    if ($$::g_pCatalogBlob{VERSION} != 2)            # not the correct blob version number
        {
        return ($::FAILURE, "Catalog blob version is " . $$::g_pCatalogBlob{VERSION} .
            ", but only version 2 is supported.", 0, 0);
        }

    return ($::SUCCESS, "", 0, 0);                    # we are done
    }

#######################################################
#
# ReadLocationsFile - read the location blob file.
#
# Params:    0 - path
#
# Returns:    0 - status
#                1 - error message
#
# Affects:    $::g_pLocationList - points to the global
#                    location hash
#
#######################################################

sub ReadLocationsFile
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ReadLocationsFile ($#_)", __LINE__, __FILE__);

    my @Response = ReadConfigurationFile($_[0]."locations.fil",'$g_pLocationList');    # load the catalog
    if ($Response[0] != $::SUCCESS)
        {
        return (@Response);
        }
    my $nVersion = 1;
    if ($$::g_pLocationList{VERSION} != $nVersion)    # not the correct blob version number
        {
        return ($::FAILURE, "Location blob version is " . $$::g_pLocationList{VERSION} .
            ", but only version $nVersion is supported.", 0, 0);
        }

    return ($::SUCCESS, "", 0, 0);                    # we are done
    }

#######################################################
#
# ReadSearchSetupFile - read the search setup blob file
#
# Params:    0 - path
#
# Returns:    0 - status
#                1 - error message
#
# Affects:    $::g_pSearchSetup - points to the global
#                    search setup hash
#
#######################################################

sub ReadSearchSetupFile
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ReadSearchSetupFile ($#_)", __LINE__, __FILE__);

    my @Response = ReadConfigurationFile($_[0]."search.fil",'$g_pSearchSetup');    # load the catalog
    if ($Response[0] != $::SUCCESS)
        {
        return (@Response);
        }
    my $nVersion = 1;
    if ($$::g_pSearchSetup{VERSION} != $nVersion) # not the correct blob version number
        {
        return ($::FAILURE, "Search setup blob version is " . $$::g_pSearchSetup{VERSION} .
            ", but only version $nVersion is supported.", 0, 0);
        }

    return ($::SUCCESS, "", 0, 0);                    # we are done
    }

#######################################################
#
# ReadTaxSetupFile - read the tax blob file.
#
# Params:    0 - path
#
# Returns:    0 - status
#                1 - error message
#
# Affects:    $::g_pLocationList - points to the global
#                    location hash
#
#######################################################

sub ReadTaxSetupFile
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ReadTaxSetupFile ($#_)", __LINE__, __FILE__);

    my @Response = ReadConfigurationFile($_[0]."taxsetup.fil",'$g_pTaxSetupBlob','$g_pTaxZoneMembersTable');    # load the file
    if ($Response[0] != $::SUCCESS)
        {
        return (@Response);
        }
    my $nVersion = 1;
    if ($$::g_pTaxSetupBlob{VERSION} != $nVersion)    # not the correct blob version number
        {
        return ($::FAILURE, "Tax setup blob version is " . $$::g_pTaxSetupBlob{VERSION} .
            ", but only version $nVersion is supported.", 0, 0);
        }

    return ($::SUCCESS, "", 0, 0);                    # we are done
    }

#######################################################
#
# ReadSectionFile - read the specified section blob
#    file
#
# Params:    0 - blob filename
#
# Returns:    0 - status
#                1 - error message
#
# Affects:    $::g_pSectionList - points to the global
#                    section hash
#
#######################################################

sub ReadSectionFile
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ReadSectionFile ($#_)", __LINE__, __FILE__);

    my @Response = ReadConfigurationFile(@_,'%g_pSectionList');        # load the configuration
    if ($Response[0] != $::SUCCESS)
        {
        $Response[0] = $::NOTFOUND;                    # translate the failure into a product not found error
        return (@Response);
        }

    return ($::SUCCESS, "", 0, 0);                    # we are done
    }


#######################################################
#
# ReadPhaseFile - read phase list
#
# Params:    0 - path
#
# Returns:    0 - status
#                1 - error message
#
# Affects:    $::g_pPhaseList - points to the global
#                    phase hash
#
#######################################################

sub ReadPhaseFile
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ReadPhaseFile ($#_)", __LINE__, __FILE__);

    my @Response = ReadConfigurationFile($_[0]."phase.fil",'$g_pPhaseList');    # load the catalog
    if ($Response[0] != $::SUCCESS)
        {
        return (@Response);
        }

    if ($$::g_pPhaseList{VERSION} != 0)                # not the correct blob version number
        {
        return ($::FAILURE, "Phase blob version is " . $$::g_pPhaseList{VERSION} .
            ", but only version 0 is supported.", 0, 0);
        }

    return ($::SUCCESS, "", 0, 0);                    # we are done
    }

#######################################################
#
# ReadPromptFile - read the prompt blob
#
# Params:    0 - path
#
# Returns:    0 - status
#                1 - error message
#
# Affects:    $::g_pPromptList - points to the global
#                    prompt hash
#
#######################################################

sub ReadPromptFile
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ReadPromptFile ($#_)", __LINE__, __FILE__);

    my @Response = ReadConfigurationFile($_[0]."prompt.fil",'$g_pPromptList');    # load the catalog
    if ($Response[0] != $::SUCCESS)
        {
        return (@Response);
        }

    if ($$::g_pPromptList{VERSION} != 0)                # not the correct blob version number
        {
        return ($::FAILURE, "Prompt blob version is " . $$::g_pPromptList{VERSION} .
            ", but only version 0 is supported.", 0, 0);
        }
    #
    # load some common values into globals
    #
    $::g_sCancelButtonLabel = GetPhrase(-1, 505);
    $::g_sConfirmButtonLabel = GetPhrase(-1, 153);
    $::g_sAddToButtonLabel = GetPhrase(-1, 154);
    $::g_sEditButtonLabel = GetPhrase(-1, 155);
    $::g_sRemoveButtonLabel = GetPhrase(-1, 156);
    $::g_sSearchButtonLabel = GetPhrase(-1, 157);
    #
    # the substitute product for products that have been deleted
    #
    %::g_DeletedProduct =
        (
        'REFERENCE' => ' ',
        'NAME' => ACTINIC::GetPhrase(-1, 174),
        'PRICE' => 0,
        'MIN' => 1,
        'MAX' => 0,
        'TAX_TREATMENT' => $ActinicOrder::ZERO
        );
    #
    # build some index tables to speed generic searches later
    #
    my @keys = keys %{$::g_pPromptList};
    my $list = join(' ', @keys);
    my @scratch = ($list =~ m/([-0-9]+),(\d+) /g);
    while ($#scratch != -1)
        {
        my $nPhraseID = pop @scratch;                    # find the next phrase ID
        push (@{$::g_PhraseIndex{pop @scratch}}, $nPhraseID); # add it to the stack for this phase
        }
    return ($::SUCCESS, "", 0, 0);                    # we are done
    }

#######################################################
#
# ReadConfigurationFile - read the specified blob
#    file
#
# Params:    0 - blob filename
#           1... optional - global variables to be shared with
#                the script
#                Format:  '$foo','$bar',... would share $::foo and $::bar
#                This triggers an attempt to load Safe.pm and eval the
#                script in a Safe compartment. If Safe.pm cannot be loaded
#                eval is used and these arguments are ignored.
#                (See EvalInSafe())
#
# Returns:    0 - status
#                1 - error message
#
# Affects:    the appropriate blob
#
#######################################################

sub ReadConfigurationFile
    {
#? ACTINIC::ASSERT($#_ >= 0, "Invalid argument count in ReadConfigurationFile ($#_)", __LINE__, __FILE__);

    my $sFilename = shift;
    my $pShared   = \@_;                    # Optional list of shared variables

    my @Response = ReadAndVerifyFile($sFilename);
    if ($Response[0] != $::SUCCESS)
        {
        return(@Response);
        }
    #
    # execute the script (parse the blob)
    #

    if( !$ACTINIC::USESAFE or $#$pShared < 0 )                    # No shared variables - use eval
        {
        if (eval($Response[2]) != $::SUCCESS)
            {
            return ($::FAILURE, "Error loading configuration file $sFilename. $@", 0, 0);
            }
        }
    else
        {
        @Response = EvalInSafe($Response[2],$ACTINIC::USESAFEONLY,$pShared);    # Try to use Safe.pm
        if( $Response[0] != $::SUCCESS)
            {
            return ($::FAILURE, "Error loading configuration file $sFilename. $Response[1]", 0, 0);
            }
        }

    return ($::SUCCESS, "", 0, 0);                    # we are done
    }

#######################################################
#
# ReadAndVerifyFile - read the specified script and
#    verify its signature
#
# Params:    0 - filename
#
# Returns:    0 - status
#                1 - error message
#                2 - script
#
#######################################################

sub ReadAndVerifyFile
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in ReadAndVerifyFile ($#_)", __LINE__, __FILE__);

    my ($sFilename);
    ($sFilename) = @_;                                    # set the blob filename

    unless (open (SCRIPTFILE, "<$sFilename"))        # open the file
        {
        return ($::FAILURE, "Error opening configuration file $sFilename. $!", 0, 0);
        }

    my $nCheckSum = <SCRIPTFILE>;                        # read the checksum
    chomp $nCheckSum;                                        # strip any trailing CRLF
    $nCheckSum =~ s/;$//;                                # strip the trailing ;

    my $sScript;
    {
    local $/;
    $sScript = <SCRIPTFILE>;                            # read the entire file
    }
    close (SCRIPTFILE);                                    # close the file
    #
    # calculate the script checksum
    #
    my $uTotal;
        {
        use integer;
        $uTotal = unpack('%32C*', $sScript);
        }
    #
    # verify the script
    #
    if ($nCheckSum != $uTotal)
        {
        return ($::FAILURE, "$sFilename is corrupt.  The signature is invalid.", 0, 0);
        }

    $sScript =~ s/\r//g;                                    # remove the dos <CR>

    return ($::SUCCESS, "", $sScript, 0);
    }

################################################################
#
# GetBuyer - retrieve the buyer given the digest
#
# Input:       0 - digest
#           1 - path
#
# Returns:    0 - status
#           1 - error message if any
#           2 - a reference to the buyer hash
#
################################################################

sub GetBuyer
    {
#? ACTINIC::ASSERT($#_ == 1, 'Incorrect parameter count ACTINIC::GetBuyer(' . join(', ', @_) . ").", __LINE__, __FILE__);
    #
    # Since we typically only retrieve one buyer per execution, it is OK to open the file,
    # do the lookup and close the file.  It is easier to maintain this way.
    #
    my ($sDigest, $sPath) = @_;
    if ($sDigest eq $ACTINIC::BuyerDigest)
        {
        return ($::SUCCESS, undef, \%ACTINIC::Buyer);
        }
    undef %ACTINIC::Buyer;
    undef $ACTINIC::BuyerDigest;
    #
    # Open and prepare the index
    #
    my $rFile = \*BUYERINDEX;
    my $sFilename = $sPath . "oldbuyer.fil";
    my ($status, $sMessage) = InitIndex($sFilename, $rFile, 0);
    if ($status != $::SUCCESS)
        {
        return ($status, $sMessage);
        }
   eval 'require Digest::MD5';        # Try loading MD5, drop dead gracefully if it is not there
   if ($@)
        {
        return ($::FAILURE, ACTINIC::GetPhrase(-1, 211, $@));
        }
    #
    # Find the buyer
    #
    my $sUserName = $ACTINIC::B2B->Get('UserName');
    my $sUserHash = Digest::MD5::md5_hex($sUserName . $sDigest);
    my $sValue;
    ($status, $sMessage, $sValue) = IndexSearch($sUserHash, 2, $rFile, $sFilename);
    if ($status != $::SUCCESS)
        {
        CleanupIndex($rFile);
        return ($status, $sMessage);
        }
    CleanupIndex($rFile);
    #
    # Parse the index value into a hash.  See CCustomerBuyerItem::operator CString for packing details.
    #
   $sValue =~ s/([^ ])$/$1 /;                            # if there is no trailing space add one
   $sValue .= 'a';                              # this is used to prevent the split from stripping trailing empty fields
    my @Details = split(/ /, $sValue);
   pop @Details;                                            # clear the trailing bogus "a"
    my @Labels = qw (ID AccountID Status InvoiceAddressRule InvoiceAddressID DeliveryAddressRule
                          DeliveryAddressID MaximumOrderValue EmailOnOrder LimitOrderValue HideRetailPrices
                          EmailAddress Name Salutation Title TelephoneNumber FaxNumber);
#? ACTINIC::ASSERT($#Details == $#Labels, 'Corrupt index ACTINIC::GetBuyer(' . "$#Details != $#Labels).", __LINE__, __FILE__);
    my $nIndex;
    #
    # Load the hash.  Note that Labels and Details are sorted in the same order
    #
    foreach ($nIndex = 0; $nIndex <= $#Details; $nIndex++)
        {
        $ACTINIC::Buyer{$Labels[$nIndex]} = DecodeText($Details[$nIndex], $ACTINIC::FORM_URL_ENCODED);
        }

    $ACTINIC::BuyerDigest = $sDigest;                # remember the digest for automated access later

    return ($::SUCCESS, undef, \%ACTINIC::Buyer);
    }

################################################################
#
# GetCustomerAccount - retrieve the customer given the ID
#
# Input:       0 - ID
#           1 - path
#
# Returns:    0 - status
#           1 - error message if any
#           2 - a reference to the account hash
#
################################################################

sub GetCustomerAccount
    {
#? ACTINIC::ASSERT($#_ == 1, 'Incorrect parameter count ACTINIC::GetCustomerAccount(' . join(', ', @_) . ").", __LINE__, __FILE__);
    #
    # Since we typically only retrieve one account per execution, it is OK to open the file,
    # do the lookup and close the file.  It is easier to maintain this way.
    #
    my ($nID, $sPath) = @_;
    if ($nID == $ACTINIC::AccountID)
        {
        return ($::SUCCESS, undef, \%ACTINIC::Account);
        }
    undef %ACTINIC::Account;
    undef $ACTINIC::AccountID;
    #
    # Open and prepare the index
    #
    my $rFile = \*ACCOUNTINDEX;
    my $sFilename = $sPath . "oldaccount.fil";
    my ($status, $sMessage) = InitIndex($sFilename, $rFile, 0);
    if ($status != $::SUCCESS)
        {
        return ($status, $sMessage);
        }
    #
    # Find the account
    #
    my $sValue;
    ($status, $sMessage, $sValue) = IndexSearch($nID, 2, $rFile, $sFilename);
    if ($status != $::SUCCESS)
        {
        CleanupIndex($rFile);
        return ($status, $sMessage);
        }
    CleanupIndex($rFile);
    #
    # Parse the index value into a hash.  See CCustomerItem::operator CString and CIndexValueCustomerAccount::operator CString for packing details.
    #
   $sValue =~ s/([^ ])$/$1 /;                            # if there is no trailing space add one
   $sValue .= 'a';                              # this is used to prevent the split from stripping trailing empty fields
    my @Details = split(/ /, $sValue);
   pop @Details;                                            # clear the trailing bogus "a"
    my @Labels = qw (EmailOnOrder InvoiceAddressRule Status InvoiceAddress PriceSchedule DefaultPaymentMethod
                          AccountName EmailAddress TelephoneNumber FaxNumber Name Salutation Title AddressList);
#? ACTINIC::ASSERT($#Details == $#Labels, 'Corrupt index ACTINIC::GetAccount(' . "$#Details != $#Labels).", __LINE__, __FILE__);
    my $nIndex;
    #
    # Load the hash.  Note that Labels and Details are sorted in the same order
    #
    foreach ($nIndex = 0; $nIndex <= $#Details; $nIndex++)
        {
        $ACTINIC::Account{$Labels[$nIndex]} = DecodeText($Details[$nIndex], $ACTINIC::FORM_URL_ENCODED);
        }

    return ($::SUCCESS, undef, \%ACTINIC::Account);
    }

################################################################
#
# GetCustomerAddress - get the customer account address
#
# Input:       0 - account ID
#           1 - address ID
#           2 - path
#
# Returns:    0 - status
#           1 - error message if any
#           2 - reference address hash
#
################################################################

sub GetCustomerAddress
    {
#? ACTINIC::ASSERT($#_ == 2, 'Incorrect parameter count ACTINIC::GetCustomerAddress(' . join(', ', @_) . ").", __LINE__, __FILE__);
    #
    # Since we occasionally retrieve multiple addresses per execution, we only open the file if it is not open
    # and leave it open until explicitly closed.
    #
    my ($nAccountID, $nAddressID, $sPath) = @_;
    my $sIdentifier = $nAccountID . ":" . $nAddressID;
    if (defined $ACTINIC::Addresses{$sIdentifier})
        {
        return ($::SUCCESS, undef, $ACTINIC::Addresses{$sIdentifier});
        }
    #
    # If the file is not open, open and prepare the index
    #
    my $sFilename = $sPath . "oldaddress.fil";
    if (!defined $ACTINIC::rAddressFileHandle)
        {
        $ACTINIC::rAddressFileHandle = \*ADDRESSINDEX;
        my ($status, $sMessage) = InitIndex($sFilename, $ACTINIC::rAddressFileHandle, 0);
        if ($status != $::SUCCESS)
            {
            return ($status, $sMessage);
            }
        }
    #
    # Find the address
    #
    my ($status, $sMessage, $sValue) = IndexSearch($sIdentifier, 2, $ACTINIC::rAddressFileHandle, $sFilename);
    if ($status != $::SUCCESS)
        {
        CleanupIndex($ACTINIC::rAddressFileHandle);
        undef $ACTINIC::rAddressFileHandle;
        return ($status, $sMessage);
        }
    #
    # Parse the index value into a hash.  See CCustomerAddressItem::operator CString for packing details.
    #
   $sValue =~ s/([^ ])$/$1 /;                            # if there is no trailing space add one
   $sValue .= 'a';                              # this is used to prevent the split from stripping trailing empty fields
    my @Details = split(/ /, $sValue);
   pop @Details;                                            # clear the trailing bogus "a"
    my @Labels = qw (ValidAsInvoiceAddress ValidAsDeliveryAddress ExemptTax1 ExemptTax2 CountryCode StateCode Name
                          Line1 Line2 Line3 Line4 PostCode Tax1ExemptData Tax2ExemptData);
#? ACTINIC::ASSERT($#Details == $#Labels, 'Corrupt index ACTINIC::GetCustomerAddress(' . "$#Details != $#Labels).", __LINE__, __FILE__);
    my $nIndex;
    #
    # Load the hash.  Note that Labels and Details are sorted in the same order
    #
    foreach ($nIndex = 0; $nIndex <= $#Details; $nIndex++)
        {
        $ACTINIC::Addresses{$sIdentifier}{$Labels[$nIndex]} = DecodeText($Details[$nIndex], $ACTINIC::FORM_URL_ENCODED);
        }

    return ($::SUCCESS, undef, $ACTINIC::Addresses{$sIdentifier});
    }

################################################################
#
# CloseCustomerAddressIndex - cleanup up the file
#
################################################################

sub CloseCustomerAddressIndex
    {
    if (defined $ACTINIC::rAddressFileHandle)
        {
        CleanupIndex($ACTINIC::rAddressFileHandle);
        undef $ACTINIC::rAddressFileHandle;
        }
    }

################################################################
#
# InitIndex - initialize the specified index file tables
#
# Input:       0 - the path to the data file
#           1 - a reference to the desired file handle
#           2 - expected file version
#
# Returns:    0 - status
#           1 - error message if any
#
################################################################

sub InitIndex
    {
#? ACTINIC::ASSERT($#_ == 2, 'Incorrect parameter count ACTINIC::InitIndex(' . join(', ', @_) . ").", __LINE__, __FILE__);
    my ($sPath, $rFileHandle, $nExpectedVersion) = @_;
    #
    # Open the index.  Retry a couple of times on failure just incase an update is in progress.
    #
    my ($status, $sError);
    my $nRetryCount = $ACTINIC::MAX_RETRY_COUNT;
    $status = $::SUCCESS;
    while ($nRetryCount--)
        {
        unless (open ($rFileHandle, "<$sPath"))
            {
            $sError = $!;
            sleep $ACTINIC::RETRY_SLEEP_DURATION;    # pause a moment
            $status = $::FAILURE;
            $sError = ACTINIC::GetPhrase(-1, 282, $sPath, $sError);
            next;
            }
        binmode $rFileHandle;
       #
       # Check the file version number
       #
        my $sBuffer;
        unless (read($rFileHandle, $sBuffer, 2) == 2) # read the blob version number (a short)
            {
            $sError = $!;
            close ($rFileHandle);
            return ($::FAILURE, ACTINIC::GetPhrase(-1, 283, $sPath, $sError));
            }

        my ($nVersion) = unpack("n", $sBuffer);    # convert to a number
        if ($nVersion != $nExpectedVersion)
            {
            close($rFileHandle);
            sleep $ACTINIC::RETRY_SLEEP_DURATION;    # pause a moment
            $status = $::FAILURE;
            $sError = ACTINIC::GetPhrase(-1, 284, $sPath, $nExpectedVersion, $nVersion);
            next;
            }

        last;
        }

    return($status, $sError);
    }

################################################################
#
# CleanupIndex - do the cleanup work
#
# Input:       0 - reference to the index file handle
#
################################################################

sub CleanupIndex
    {
    close ($_[0]);
    }

###############################################################
#
# IndexSearch - search an index for the key.  The result of
#   this recursive function is the index value.  This function
#   assumes that each key has exactly one value.  It can
#   be used for product and account indices.  Search indices
#   where multiple results are possible should use another
#   form of this function.
#
# Input:       0 - search key (or remaining fragment on
#               recursive call)
#           1 - point to start in the file
#           2 - file handle
#           3 - file path (for identification in errors)
#
# Returns:  0 - status
#           1 - error message
#           2 - value
#
###############################################################

sub IndexSearch
    {
#? ACTINIC::ASSERT($#_ == 3, 'Incorrect parameter count IndexSearch(' . join(', ', @_) . ").", __LINE__, __FILE__);
    my ($sKey, $nLocation, $rFile, $sFileName) = @_;

    my ($nDependencies, $nCount, $nRefs, $sRefs, $sBuff, $sFragment, $sValue);
    my ($nIndex, $sSeek, $nHere, $nLength, $sNext, $nRead);
    #
   # At the start of the file, we have an (empty) value list
   # followed by a list of dependency records
    #
    unless (seek($rFile, $nLocation, 0))            # Seek to node
        {
        return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
        }
    #
   # Read the value (if any).
    #
    unless (read($rFile, $sBuff, 2) == 2)            # Read the count
        {
        return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
        }

    ($nCount) = unpack("n", $sBuff);                    # Turn into an integer

    for ($nIndex = 0; $nIndex < $nCount; $nIndex++)
        {
        unless (read($rFile, $sBuff, 2) == 2)        # Get value length
            {
            return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
            }

        ($nLength) = unpack("n", $sBuff);            # unpack the value length

        unless (read ($rFile, $sValue, $nLength) == $nLength) # read the value
            {
            return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
            }

        unless (read($rFile, $sBuff, 1) == 1)        # read the reference count
            {
            return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
            }
        ($nRefs) = unpack("C", $sBuff);                # Unpack it

        $sRefs = "";                                        # Kill left-over references
        if ($nRefs > 0)
            {
            unless (read($rFile, $sRefs, $nRefs) == $nRefs)    # Read and ignore the actual refs
                {
                return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
                }
            }

        if ($sKey eq "")                    # If this is an exact match
            {
#? ACTINIC::ASSERT(1 == $nCount, "Index match not unique.", __LINE__, __FILE__);
            return ($::SUCCESS, undef, $sValue);
            }
        }
    #
   # Now search the dependencies
   #
    unless (read($rFile, $sBuff, 2) == 2)            # Read count
        {
        return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
        }
    $nDependencies = unpack("n", $sBuff);            # Count of dependencies (network short)

    for ($nIndex = 0; $nIndex < $nDependencies; $nIndex++)
        {
        unless (read($rFile, $sBuff, 1) == 1)        # Read fragment length
            {
            return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
            }
        $nLength = unpack("C", $sBuff);                # Unpack it

        unless (read($rFile, $sFragment, $nLength) == $nLength) # Read the string fragment
            {
            return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
            }
        unless (read($rFile, $sSeek, 4) == 4)        # Read the link (convert later, if we need it)
            {
            return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
            }
        #
        # We only care about the fragment length as far as
        # the length of the word we're looking for
        #
        $sFragment = substr($sFragment, 0, length($sKey)); # Reduce fragment to useful length
        #
        # If the fragment partially matches our word then we
        # continue down the tree. It only needs to match as much
        # of the word as we have - it's perfectly possible for
        # the fragment to be longer than the word
        #
        if ($sKey =~ m/^$sFragment/) # Does it match?
            {
            $sNext = $';                                    # Get part after match
            $nHere = tell($rFile);                        # Save where we are

            my ($status, $sError, $sValue) = IndexSearch($sNext, unpack("N", $sSeek), $rFile, $sFileName); # Look down tree
            if ($status == $::FAILURE ||                # if the lookup errored or
                 $status == $::SUCCESS)                    # if it was completed,
                {
                return ($status, $sError, $sValue);    # return the state
                }
            #
            # If we are here, $::NOTFOUND was returned, try the next one
            #
            unless (seek($rFile, $nHere, 0))            # Back to where we were
                {
                return ($::FAILURE, ACTINIC::GetPhrase(-1, 285, $sFileName, $!));
                }
            }

        if ($sFragment gt $sKey)                        # If we've passed the point in the list
            {
            last;                                                # Don't look further
            }
        }

    return ($::NOTFOUND, 'Item not found in index');
    }

#######################################################
#
# GetPhrase  - Get the specified phrase and format it.
#
# Params:    0 - phase number
#                1 - prompt number
#                2+ - optional list of arguments supplied
#                    to complete string formatting
#
# Returns:    0 - prompt string
#
#######################################################

sub GetPhrase
    {
#? ACTINIC::ASSERT($#_ >= 1, "Invalid argument count in GetPhrase ($#_)", __LINE__, __FILE__);

    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    no strict 'refs';                                        # this class routine symbolic references
    my ($nPhase, $nPrompt, @args);
    if ($#_ < 1)                                            # incorrect number of arguments
        {
        $nPhase = -1;                                        # return parameters not set
        $nPrompt = 12;
        @args = ('GetPhrase');
        }
    else
        {
        ($nPhase, $nPrompt, @args) = @_;
        }

    my ($sPhrase);
    if (defined $::g_pPromptList)                        # if the phrase list is defined and
        {
        $sPhrase = $$::g_pPromptList{"$nPhase,$nPrompt"}{PROMPT};
        }
    elsif (defined $::g_InputHash{"PHRASE$nPhase,$nPrompt"}) # the phrases are in hidden parameters
        {
        $sPhrase = $::g_InputHash{"PHRASE$nPhase,$nPrompt"};
        }
    else
        {
        return ("Phrases not read yet ($nPhase,$nPrompt) {" . join(', ', @args) . "}.");            # report so
        }
    #
    # process any substitution
    #
    if (defined $sPhrase &&                                # if the phrase was found and
         $#args > -1)                                        # there are values to substitute
        {
        $sPhrase = sprintf($sPhrase, @args);        # perform the substitution
        }

    if (defined $sPhrase)                                # if the phrase was defined
        {
        return ($sPhrase);                                 # return the phrase
        }

    return ("Phrase not found ($nPhase,$nPrompt) {" . join(', ', @args) . "}!!");
    }

#######################################################
#
# GetRequireMessage - retrieve the "this field is required"
#    message for the specified phase and prompt
#
# Params:    0 - phase number
#                1 - prompt number
#
# Returns:    0 - message
#
#######################################################

sub GetRequiredMessage
    {
#? ACTINIC::ASSERT($#_ == 1, "Invalid argument count in GetRequireMessage ($#_)", __LINE__, __FILE__);
    return
            (
            GetPhrase(-1, 55, "\"<B><FONT COLOR=\"" . $::g_sRequiredColor .
            "\">" . GetPhrase($_[0], $_[1]) . "</FONT></B>\"") . "<BR>\n"
            );
    }

#######################################################
#
# IsPromptRequired - is the specified prompt required.
#    For simplicity, all errors return $::FALSE.
#
# Params:    0 - phase number
#                1 - prompt number
#
# Returns:    0 - $::TRUE if required
#
#######################################################

sub IsPromptRequired
    {
#? ACTINIC::ASSERT($#_ == 1, "Invalid argument count in IsPromptRequired ($#_)", __LINE__, __FILE__);

    no strict 'refs';                                        # this class routine symbolic references
    if ($#_ != 1)                                            # incorrect number of arguments
        {
        return ($::FALSE);
        }

    my ($nPhase, $nPrompt) = @_;
    #
    # locate the prompt and return its status
    #
    return ($$::g_pPromptList{"$nPhase,$nPrompt"}{STATUS} == $::REQUIRED ? $::TRUE : $::FALSE); # return it's required status
    }

#######################################################
#
# IsPromptHidden - is the specified prompt hidden.
#    For simplicity, all errors return $::FALSE.
#
# Params:    0 - phase number
#                1 - prompt number
#
# Returns:    0 - $::TRUE if hidden
#
#######################################################

sub IsPromptHidden
    {
#? ACTINIC::ASSERT($#_ == 1, "Invalid argument count in IsPromptHidden ($#_)", __LINE__, __FILE__);
    no strict 'refs';                                        # this class routine symbolic references
    if ($#_ != 1)                                            # incorrect number of arguments
        {
        return ($::FALSE);
        }

    my ($nPhase, $nPrompt) = @_;
    #
    # locate the prompt and return its status
    #
    return ($$::g_pPromptList{"$nPhase,$nPrompt"}{STATUS} == $::HIDDEN ? $::TRUE : $::FALSE); # return it's hidden status
    }

#######################################################
# ChangeAccess
#     Change the access permissions using the various
#     platform specific calls.
#
# Params:    0 - the new mode of the file.  supported
#                    modes are '' - no permissions,
#                    "r" - read only, "rw" - read/write
#             1 - the file to modify
#
# Returns:    number of files changed
#
#######################################################

sub ChangeAccess
    {
# No assert here because ASSERT calls TRACE which calls ChangeAccess - recursion loop
    #
    # !!!!!! This is a function commonly used by many utilities.  Any changes to its interface will
    # !!!!!! need to be verified with the various utility scripts.
    #

    my ($mode, $file, $nCount);
    ($mode, $file) = @_;

    SecurePath($file);                                    # make sure only valid filename characters exist in $file to prevent hanky panky
    if ($mode eq '')                                        # no permissions
        {
        $nCount = chmod 0200, $file;                    # process chmod on unix
        }
    elsif ($mode eq "rw")
        {
        $nCount = chmod 0666, $file;                    # process chmod on unix
        }
    elsif ($mode eq "r")
        {
        $nCount = chmod 0644, $file;                    # process chmod on unix
        }

    return ($nCount);
    }

#######################################################
#
# CleanFileName - Clean iffy characters from file name
#    only letters, digits, '.','_','-' allowed
#    each is changed into '_'
#
#    CAUTION: '/' is not allowed!
#
# Params:    file name
# Returns:    modified name
#
# (rz)
#######################################################

sub CleanFileName
    {
    my $nam = shift;
    $nam =~ tr/a-zA-Z0-9\.\_\-/_/c;
    return $nam;
    }

#######################################################
#
# SecurePath2 - Return an error if the specified path contains
#    any shell characters
#
# Input:       0 - path
#
# Returns:  0 - error or undef
#
#######################################################

sub SecurePath2
    {
    my ($sPath) = $_[0];
    if ($^O eq 'MSWin32')                                # NT
        {
        if ($sPath =~ m|[!&<>\|*?()^;\${}\[\]\`\'\"~\n\r]| ||        # the secure path characters (allow backslashes)
             $sPath =~ m|\0|)
            {
            return("\"$sPath\" contains invalid characters.");
            }
        }
    else
        {
        if ($sPath =~ m|[!&<>\|*?()^;\${}\[\]\`\'\"\\~\n\r]| ||        # the secure path characters (no backslashes)
             $sPath =~ m|\0|)
            {
            return("\"$sPath\" contains invalid characters.");
            }
        }
    return (undef);
    }

#######################################################
#
# SecurePath - Error out if the specified path contains
#    any shell characters
#
# Params:    0 - path
#
#######################################################

sub SecurePath
    {
    my $sError = SecurePath2(@_);
    if ($sError)
        {
        TerminalError($sError);
        }
    }

#######################################################
#
# CheckForShellCharacters - this is not as safe as
#  only tolerating specific characters, but for this
#  release, this is all we have time for.
#
# Input:       0 - value to check
#
# Returns:  0 - error message if any, undef if OK
#
#######################################################

sub CheckForShellCharacters
    {
    my ($sValue) = $_[0];
    if ($sValue =~ m|[!&<>\|*?()^;\${}\[\]\`\'\"\\~\n\r]| ||        # the secure path characters (no backslashes)
         $sValue =~ m|\0|)
        {
        return ("\"$sValue\" contains invalid characters.");
        }
    return (undef);
    }

#######################################################
#
# GetPath - retrieve the path to the catalog directory
#
# Returns:  0 - path
#
#######################################################

sub GetPath
    {
    return ($ACTINIC::s_sPath);
    }

#######################################################
#
# AuthenticateUser - verify the username and password
#  Exits on error.
#
# Input:       0 - user
#                1 - password
#
# Returns:  0 - status
#           1 - message
#
#######################################################

sub AuthenticateUser
    {
    my ($sUsername, $sPassword) = @_;
    my ($sCorrectUsername, $sCorrectPassword) = ('NETQUOTEVAR:USERNAME', 'NETQUOTEVAR:PASSWORD');
    #
    # The username and password must be defined.
    #
    if (!$sUsername ||
         !$sPassword)
        {
        sleep $ACTINIC::DOS_SLEEP_DURATION;            # Discourage DOS attacks
        return ($::FAILURE, "Undefined Catalog username or password.  Check your Housekeeping | Security settings and try again.  If that fails, try refreshing the site.");
        }
    #
    # Verify the account
    #
    if (!NETQUOTEVAR:ACTINICHOSTMODE)                # stand alone mode
        {
        if ($sUsername ne $sCorrectUsername ||        # either the username or password does not match
             $sPassword ne $sCorrectPassword)
            {
            sleep $ACTINIC::DOS_SLEEP_DURATION;        # Discourage DOS attacks
            return ($::FAILURE, "Bad Catalog username or password.  Check your Housekeeping | Security settings and try again.  If that fails, try refreshing the site.");
            }
        }
    else                                                        # Actinic Host mode
        {
        #
        # Load the module for access to the configuration files
        #
        eval 'require MallUtil;';
        if ($@)                                                # the interface module does not exist
            {
            return ($::FAILURE, 'An error occurred loading the MallUtil module.  ' . $@);
            }
        #
        # Retrieve the appropriate record
        #
        my $pShop;
        my ($status, $sError) = MallUtil::GetShopRecordFromUsernameAndPassword($sUsername, $sPassword, \$pShop);
        if ($status == $::BADDATA)
            {
            sleep $ACTINIC::DOS_SLEEP_DURATION;        # Discourage DOS attacks
            return ($status, $sError);
            }
        elsif ($status != $::SUCCESS)
            {
            return ($status, $sError);
            }
        }

    return ($::SUCCESS, undef);
    }

#######################################################
#
# GetLastNonScript - return the last non-script page
#     in a page list.
#
# Params:    0 - pointer to page list
#
# Returns:    $sRefPage    - last non-script page or the
#                                last page
#
#######################################################

sub GetLastNonScript
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in GetLastNonScript ($#_)", __LINE__, __FILE__);
    my ($sRefPage, $pPageList, $i);
    ($pPageList) = @_;

    $sRefPage = $$pPageList[-1];                        # make sure we return something!!
    #
    # build the pattern for our script name with '\w\w' in place of os, ca, al etc
    #
    my $sScriptURL = sprintf('%s(nph-)?\w\w%6.6d%s', $$::g_pSetupBlob{'CGI_URL'}, $$::g_pSetupBlob{'CGI_ID'},
        $$::g_pSetupBlob{'CGI_EXT'});                    # the cart script URL
    #
    # go through the list backwards looking for a page
    # that doesn't match our script reg exp
    #
    for($i = $#$pPageList; $i >= 0; $i--)
        {
        if($$pPageList[$i] !~ m#^$sScriptURL#)        # if the start doesn't look like one of our scripts
            {
            return($$pPageList[$i]);                    # assume this is a catalog page
            }
        }
    return($sRefPage);                                    # return our default page
    }

##############################################################################################################
#
# File Read Calls - End
#
##############################################################################################################

##############################################################################################################
#
# Blob Write Library - Begin
#
##############################################################################################################

#######################################################
#
# OpenWriteBlob - open the blob for write access
#    If the specified filename is empty, use STDOUT.
#    Note that STDOUT mode buffers the message and
#  writes on Close using HTTP header
#
# Params:    0 - filename - if filename == '',
#                    then use standard out
#
# Returns:    0 - status
#                1 - error message
#
# Affects:    WBFILE - file handle
#                $s_WBBuffer - file buffer
#                $ACTINIC::s_WBStyle - the blob style
#                    = $ACTINIC::FILE - file
#                    = $ACTINIC::STDOUT - STDOUT
#                    = $ACTINIC::MEMORY - memory
#
#######################################################

sub OpenWriteBlob
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument count in OpenWriteBlob ($#_)", __LINE__, __FILE__);

    my ($sFilename) = @_;

    if (length $sFilename > 0 &&                        # if we are writting to a file, open it
         $sFilename ne "memory")
        {
#?     ACTINIC::ASSERT(undef, "This path is potentially not secure - can we remove it?", __LINE__, __FILE__);
        SecurePath($sFilename);                            # make sure only valid filename characters exist in $file to prevent hanky panky
        unless (open (WBFILE, ">$sFilename"))        # open the file
            {
            return ($::FAILURE, "Unable to open $sFilename for writing: $!\n", 0, 0);
            }

        binmode WBFILE;                                    # make sure the file is written in binary mode

        $ACTINIC::s_WBStyle = $ACTINIC::FILE;                                # writing to file
        }
    elsif ($sFilename eq "memory")
        {
        $ACTINIC::s_WBBuffer = '';                                    # clear the buffer
        $ACTINIC::s_WBStyle = $ACTINIC::MEMORY;                            # writing to memory
        }

    return ($::SUCCESS, '', 0, 0);
    }

#######################################################
#
# WriteBlob - write the blob
#
# Params:    0 - \@FieldList - reference to an array
#                    of field values to store
#                1 - \@FieldType - ref to an array of field
#                    types (in the same order as FieldList
# Returns:    0 - status
#                1 - error message
#
# Expects:    WBFILE - file handle
#
#######################################################

sub WriteBlob
    {
#? ACTINIC::ASSERT($#_ == 1, "Invalid argument count in WriteBlob ($#_)", __LINE__, __FILE__);

    my ($FieldList, $FieldType) = @_;

    my ($Field, $Type, @Response, $i);
    for($i = 0; $i <= $#{$FieldList}; $i++)        # loop over the fields in the table
        {
        $Type = $$FieldType[$i];                        # the field data type
        $Field = $$FieldList[$i];                        # the field value

        if ($Type == $::RBBYTE)                            # this field is a byte
            {
            @Response = WriteByte($Field);            # Write the byte
            }
        elsif ($Type == $::RBWORD)                        # this field is a Word
            {
            @Response = WriteWord($Field);            # Write the Word
            }
        elsif ($Type == $::RBDWORD)                    # this field is a double word
            {
            @Response = WriteDoubleWord($Field);    # Write the double word
            }
        elsif ($Type == $::RBQWORD)                    # this field is a Java long (64 bits)
            {
            @Response = WriteQuadWord($Field);        # Write the QuadWord
            }
        elsif ($Type == $::RBSTRING)                    # this field is a string
            {
            @Response = WriteString($Field);            # Write the string
            }
        else                                                    # unknown field type
            {
            return ($::FAILURE, "Unknown field type $Type\n", 0, 0); # return error
            }

        my ($Status, $Message);
        ($Status, $Message) = @Response;                # extract the results

        if ($Siel, 2)###
Rrase)                                # );            #f thed,ld type
            {
            re;
        ($Status, $ESS, "", 0# b th 0, 0);
            }
        }

    return ($::SUCCESS, '', 0, 0);
    }

#######################################################
#                                                            tes o
# Writeup and clote the blob
#
# Returns:    0 - status
#                1 - error message
#    ffer - file busage
#
# E ffects:    WBFILE - file handle
#                $ACTINIC::s_WBSflag Searcy toler    if ($ arfects: handle
#                $ACTINI        $s_WBBuath to t- filee val
#                $ACTINIC::s_W!BStyle = $ACTINI)f if OK
#
#######################################################
es o
# WrssIndex
    {fer
        $ACTINIC::s_WBBStyle = $ACTINI)e                                en the file

    {
    fects:Phrase');
        }
    else                                    ing to memr})
        {
        return ($::SUCCES
#                $ACTINI        $s_W $!", 0, 0);
        }

    return ($::SUCCESS$sError);
    }

##############################################################################################################
#
# Blob Write Liballs - End
#
##############################################################################################################

##############################################################################################################
#                                                            Low Le tl
# Blob Write Library - Begin
#
##############################################################################################################

#######################################################
#                                                            onse = WriteBlob -eld is a blob
#
# Paramd is    # Ba read/weldList
# Returns:    0 - status
#                1 - error message
#
# Ex
#                $ACTINIC::s_WBSSearcy toleFILE s:    0 - statusfects:    WBval
#                $ACTINIC::s_WBBStyle = $ACTINI handle
#                $ACTINI        $s_WBBuval
#                $ACTINIC::s_W!BStyle = $ACTINI handle
#
#######################################################

sube the Blob
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument coonse = WriteBlob ($#_)", __LINE__, __FILE__);

SIZ:FA$= WrFA$2ExemptD
SIZ:nPro            last;                            decletailsmwith t file tge)= WreldType) =$2Exe    for() = @_;2Exe    fo            #  unpack= Wree) = @_;
    fer
        $ACTINIC::s_WBBStyle = $ACTINI)e                                                    # if we ae writting tondex++)
        {
        uURL =rfects:A$2ExemMORY;                        nd clot to a numype
            {
            return ($::FAI
    my $we ae wramd is    # Be sure twriting: $ site.");
            }
        }
    else                                                        # if dumpe writt usiemory")
        {
        $ACTINIC::s_WB.=A$2Exe:MEMORY;        ap < $path to th# Be suar the bufory
        }

    return ($::SUCCESS, '', 0, 0);
    }

#######################################################
#
he QiteBlob -elhe Qi concies (nd is    e sameacte####lds iup up the filb
#
# Parames our Ba read/weldList
# Returns:    0 - status
#                1 - error message
#
# Ex
#                $ACTINIC::s_WBSSearcy toleFILE s:    0 - statusfects:    WBval
#                $ACTINIC::s_WBBStyle = $ACTINI handle
#                $ACTINI        $s_WBBuval
#                $ACTINIC::s_W!BStyle = $ACTINI handle
#
#######################################################

suhe QuadBlob
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument coonse he QiteBlob ($#_)", __LINE__, __FILE__);

SIZ:FA$W$sPas$2ExemptD
SIZ:nPr2            last;                            decletailsmwith t file tge)W$sPassword) =$2Exe    for() = @_;2Exe    fo            #  unpackW$sPae) = @_;
    fer
        $ACTINIC::s_WBBStyle = $ACTINI)e                                                    # if dumpe writting tondex++)
        {
        uURL =rfects:A$2ExemMORY;                        nd clot to a numype
            {
            return ($::FAI
    my $we ae wrames our Be sure twriting: $ site.");
            }
        }
    else                                            # if dumpe writt usiemory")
        {
        $ACTINIC::s_WB.=A$2Exe:MEMORY;        ap < $pa path to thar the bufory
        }

    return ($::SUCCESS, '', 0, 0);
    }

#######################################################
#
= WriteDouiteBlob -eldwe Qi concies (nd is    e sam####acterlds iup up the filb
#
# Paramte the doubur Ba read/weldList
# Returns:    0 - status
#                1 - error message
#
# Ex
#                $ACTINIC::s_WBSSearcy toleFILE s:    0 - statusfects:    WBval
#                $ACTINIC::s_WBBStyle = $ACTINI handle
#                $ACTINI        $s_WBBuval
#                $ACTINIC::s_W!BStyle = $ACTINI handle
#
#######################################################

su= WriteDouuadBlob
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument coonse = WriteDouiteBlob ($#_)", __LINE__, __FILE__);

SIZ:FA$DW$sPas$2ExemptD
SIZ:nPr4            last;                            decletailsmwith t file tge)DW$sPassword) =$2Exe    for() = @_;2Exe    fo            #  unpackDW$sPae) = @_;
    fer
        $ACTINIC::s_WBBStyle = $ACTINI)e                                                    # if dumpe writting tondex++)
        {
        uURL =rfects:A$2ExemMORY;                        nd clot to a numype
            {
            return ($::FAI
    my $we ae wramte the doubur Be sure twriting: $ site.");
            }
        }
    else                                            # if dumpe writt usiemory")
        {
        $ACTINIC::s_WB.=A$2Exe:MEMORY;        ap < $pa path to thar the bufory
        }

    return ($::SUCCESS, '', 0, 0);
    }

#######################################################
#
te the QiteBlob -eld is a Java long (6i concies (####d is    e sameacterlds iup up the filb
#
# Paramqe t doubur Ba read/weldList
# Returns:    0 - status
#                1 - error message
#
# Ex
#                $ACTINIC::s_WBSSearcy toleFILE s:    0 - statusfects:    WBval
#                $ACTINIC::s_WBBStyle = $ACTINI handle
#                $ACTINI        $s_WBBuval
#                $ACTINIC::s_W!BStyle = $ACTINI handle
#
#######################################################

sute the QuadBlob
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument coonse te the QiteBlob ($#_)", __LINE__, __FILE__);

SIZ:FA$te the Qas$2ExemptD
SIZ:nPr8            last;                            decletailsmwith t file tge)te the Qassword) =$2Exe    for() = @_;
    @= Wrt, @ark= Wrs[0]    for(    last;                             long  a Ja            modhrases otenfile.  supprk= Wrs[1]    for() =k= Wrs[2]    for() =k= Wrs[3]    for() =k= Wrs[4]    foe)te the Q & hex("ff000000ilena        >> 24() =k= Wrs[5]    foe)te the Q & hex("ff0000ilena        >> 16() =k= Wrs[6]    foe)te the Q & hex("ff00ilena            >> r8    ) =k= Wrs[7]    foe)te the Q & hex("ff"))() = @_;2Exe    fo            #  un8b (@= Wrt, @ar @_;
    fer
        $ACTINIC::s_WBBStyle = $ACTINI)e                                                    # if dumpe writting tondex++)
        {
        uURL =rfects:A$2ExemMORY;                        nd clot to a numype
            {
            return ($::FAI
    my $we ae wram8nd is    doubur Be sure twriting: $ site.");
            }
        }
    else                                                        # if dumpe writt usiemory")
        {
        $ACTINIC::s_WB.=A$2Exe:MEMORY;        ap < $pa path to thar the bufory
        }

    return ($::SUCC', 0, 0);
    }

#######################################################
#
rator CteBlob -elad the stterlds up the filb
#
# Paramad the r Ba read/weldList
# Returns:    0 - status
#                1 - error message
#
# Ex
#                $ACTINIC::s_WBSSearcy toleFILE s:    0 - statusfects:    WBval
#                $ACTINIC::s_WBBStyle = $ACTINI handle
#                $ACTINI        $s_WBBuval
#                $ACTINIC::s_W!BStyle = $ACTINI handle
#
#######################################################

suSe the stBlob
    {
#? ACTINIC::ASSERT($#_ == 0, "Invalid argument coonse rator CteBlob ($#_)", __LINE__, __FILE__);

Sator as$2Exeragment, $nst, $iSator assword) =$2Exe    for() =        }
        $nLe
    if (lSator () = @_;
    @ge) = @Rnst,     {
            @Response = Writment, $nsMORY;                        nd cload the useful le
    #
{
            @Rose   memr})
        {
        r@ge) = @Rns    $/$1 /;                            # ifphraReturn a, b th 0, E);
        }

= Wrent, $nst,
= Wrent, $nPr2 *agment, $;                                        i]} =ilses thalenas fi2nd iss@ar @_;
    f
= Wrent, $n$nRe    $/$1 /;                            # if thins
d the to t memr})
}

P        # (@orShellCha site.")
    P        #    $sRa".    f
= Wrent, $n/ 2 $sBuff)            # unpate the str;2Exe    fo            #
P        # (iSator asite.")
    P        #    $sRC".f
= Wrent, $;                                                    # unpaSearvidthe  shell chara        @orShellChanLength =
P        # (i2ExemptD    .")
    P        #    $sRxC" x     f
= Wrent, $n/ 2 $sBu# ces     # locat        #
d the xCxCxC...
#    Notnd
#  eithe    i]} =ile the str;2Exe    fo            #
P        # (@orShellCha sBuff)            # unpae    i]} =ile the strlts

er
        $ACTINIC::s_WBBStyle = $ACTINI)e        # dumpe written the file
                {
        uURL =rfects:A$2ExemMORY                        nd clorawite the strire
                {
                return ($::FAI
    my $we ae wramad the r Be sure twriting: $ site.");
            wn tree

= Wrent, $n$n4096)1)                                        #seems!! needwed mithe  how a Javnumbmad the weecure  read/trire
                {
                return ($::FAI
    my $we ae wramad the stterlds up t:mad the  th".de Name
    "\n\t to be longe4K
#                b fiy b rase and y $b rae blob ing: $ site.");
            ng
            }
        else                                dumpe writt usiemorch?
                {
        $ACTINIC::s_WB.=A$2Exe:MEMORY        ap < $pa path ar the buf0);
            }
        }

    return ($::SUCC$sError);
    }

##############################################################################################################
#                                                            Low Le tl
# Blob Write Liballs - End
#
##############################################################################################################

#####################################################asswor 0,InSot a-or 0,tch our Sot lyasswoalue.  This fage ame s!! ncurr Sot .pmallUtil asswoIfnfiwrit to         #                 execu comments stch our
#   Sot asswoalue\" lee __);ysUND, which only   # fottine surIf the spasswoth t fileDetailrShed) asswoO                wi@Re'se ce' swisn't(sealu"Invalid a)
#    eaceck requi againrue are rn sose lik littintus == $::FiOUND was rqui agaifa    }
#         0,t# this is u     0,u     # ch ourequi aqui aAer of argu     turnsh our s u     0,gu
#    se ce swisn'gu     2eldList - referenptional lth t fileD! needlrShedpt na status
#    unpath ourequi a le paand: ('$foo','$bla')#                 cters lrSh sostusfooittintusblave call)return ($::ittintus == $::FetailrShed autoandi whiyve calist
# gu     turns  0 - status       1 - error mprompt st aqui agai     0,t# texecu cd ( ||        #
# Sot a errClose     0,)ur woqui ar    if ($ttin   1 - error mesultwe've stter     0,equi a(gai      1 - error mactersur worr    if ($, thiwaysntus == $::)qui agai'se ce' flag S  writtinSot .pma- this se notr worr    if (qui aval
us == $::equi agaiSot .pmadet
# enpviolonfigur    if ($, t
us == $::messagee
a        to:qui agai$th Value\" co
   #tolerh our:qui a},
t
            $s"!!!!!! T}
t
        ";qui a},
t
        1    $s"!!!!!! T}
t
        1";qui aerrors rets = $::SUCt aqui ar woqui a}

Rt the$Stasg asswr 0,InSot ($th ,TRUE : $,'$
t
        C$sErt aqui a                 errors rets = $:: statusgaiSot .pmaactersur wor},
t
            ! Tsetacter},
t
        1    irameters notatusgaiSot .pmamodule does nour worbont l        #setErt aqui a}

Rt the$Stasg asswr 0,InSot ($th ,TRUE : $,'$
t
        C,'$
t
        1C$sErt aqui aerrorss eturn ($::ittinsetsr},
t
            ttintus
t
        1Ert aqui a}

Rt the$Stasg asswr 0,InSot ($th ,TRUN ? ,'$
t
        C$sErt aqui aerrorss eturn ($::ittinsetsr},
t
            iaiSot .pmaactersqui aerrorss etu == $::Fetinsetsre rn soso                wi@RmessageeRysze stZyb No  Mnas24 18:09:02 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as###
r 0,InSot urePath
    {
LastNony $nam =le);        h our s u     0,guh
    {bFe ce ny $nam =le);    gainrue dangene surt namSot ure        #
        l        #ny $nam =le);    Rist - referenptional llrShed th t file tg        #
Rt theFILE__        #
        eval 'rSot '=le);    Trned ncurr Sot .pm @_;
( $@ )e                                Canhis sinot t; $i--)
        {    {bFe ce )sKey)                unnot a     0,t# tse bPromptHimype
            {
            return ($::FAICanhis curr Sot .pm"$sValue);    # mes on , $!));
        Rt theny      0,({
LastNo$sValo                wi@R jswor        th     0,guh            }
        }
    else    # Sot ase no memr})
}
$pC        $nC - tSot ()(    last;                            Sot aalue\" le;
        pC        ->lrShe_stte(' (or',['$rn ($::C,'$rn ($::']", 0# AiwaysnlrSheur wand wo;
        pC        ->lrShe_stte(' (or',
        l        ilename);                l        #th t fileDIf the spas
        Rt theny     pC        ->r     0,({
LastNo$sVname);        r 0,tunpath ourguh            }
;
( $@ )e                                I                # if thins:  0 - error met!! Thises on , $!{as
        Rt theny     tus = $::FAILU");
        }
    r
Rt the$.  '                    de next 0);
    }

#######################################################
#                                                             calls-adebuwrir' inf this fu lhe kse ||        # t na st    ser looigu            # 9876 okingup the filb
#
# PtURL =  "rw"yptionaalue\"  sos error n error.
aC - lss r! Thutoandi whiy    ap < $s changed
#
#####################################################?###
 call###?tBlob
$|nPro    ###?t
    {
RequireMiptURL = s$nam in(',() = @#?twhILE
er
        $ACTIbTr' iSockFirssCorr) @#?ttBlob
                {
        $ACTIbTr' iSockFirssCorrny     tus : $ptD    .")b
        }

can te,
        #espoadd $sEpadd $sEproto$sElss )ptD    .")b

can te#ny '    #
lhost';")b

            #  #ny 9876;")b
        ee
                # =~ /\D/) @#?tttBlob

            # = getser by($sF(
        #es'tcp') @#?ttt}")b
        ee
!
        #) @#?tttBlob
                {
     @#?ttt}")b
        ee
!(poadd  = ss t_aton
can te))) @#?tttBlob
                {
     @#?ttt}")b
        Epadd  #ny sockadd _in(
        #espoadd )ptD    .")b

proto #ny getprotoby($sF('tcp')     @#?tt__);
    no srm t';")b
        ee
!socket(DBOUT, PF_INET, SOCK_STREAM$sEproto)) @#?tttBlob
                {
     @#?ttt}")b
        ee
!alun
#(DBOUT, Epadd )) @#?tttBlob
                {
     @#?ttt}")    .")b

    {
        $ACTIbTr' iSockeeny     tuN ? ;#####?        URL =rDBOUT    "\n\n"     @#?tt}#####?    whILE
!
    {
        $ACTIbTr' iSockeen&& @#?ttt
    {
        $ACTIbTr' isif FirssCorr) @#?ttBlob
                {
        $ACTIbTr' isif FirssCorrny     tus : $ptDb
        }
elsif ($sFi=

sub (</B>'output.txt';")b
         calls Chang('rw', rePath($sFil")b
        _);
        SecurePath($sFilename);;                            # make sure only valid filename characters exist in $file to prevent hanky b
        nless DBOUT, BFILE, ">$sFil     @#?tt}##.")b
    URL =rDBOUT    {
RequireM.    "\n"     @#?t 0);
    }

#######################################################
#                                                            ecause -adebuwrecause f this fuhe filb
#
# Paramalu"infigulenamea    }
,
    # w ref
# Nobstittatus
#     error messocapprverified wi
# Nobstittatus2eldlss rturns:    ack to
# Nobst i- status3    WBFILE alue\"  sos
# Nobstittnged
#
#####################################################?e fibrecause###?e tBlob
     }

bTeFieldsatus, $ES$nLss , rePathassword) b
     ee
!
bTeFi)) b
     tBlob
                 {
        $ACA
# NoIs                veny     tuN ? ;##b
         }
elT
            $s'A
# Nobst f thed:odule.
RequireM.    ' (dule.

.joinlss :odule.nLss
.jo)';#####?e s

er
        $ACA
# NoIsLoope w)) b
     ttBlob
             }
ele ReS DOS;##b
             ele ReS DOS    $se ReS DOS();##b
              call(elT
            .
ele ReS DOS);##b
             actt;##b
             }lob
                 {
        $ACA
# NoIsLoope wny     tuN ? ;#####?
          call(elT
        );##b
         }
ele ReS DOS;##b
         ele ReS DOS    $se ReS DOSHTML();##b
                 {
        TerminalET
            .
ele ReS DOS);##b
         }lob
      0);
    }

#######################################################
#                                                            t ReS DOS    #                ); # a, whiur    i to check
#
# Read the  whiur    i t string ethe w
   #s:nto '_' (or,dlss rturns:sageef this f,dlss rturns:sageery thf this f,dlss rturns:sag    ..n errrror nthf this f,dlss rturns:sagnged
#
#####################################################?###
t ReS DOS###?tBlob
    }
@ whiu=  whier(1)    ###?t
    {lss ry      whi[2]    ###?t
    {c        $nC2;#####?    }
@s DOS;#####?    whILE
RE, "Un(     whi[0])) @#?ttBlob

    {cwhierry      whi[0]    ###?t    @ whiu=  whier({c        l     @#?tt     whi[3]    fo{cwhierree
!RE, "Un(     whi[3])l     @#?ttunnnam (@s DOS,      whi[3]    .    ", B    .
elss )ptD#?tt    lss ry      whi[2]    ###?t    {c        ++     @#?tt}###?t
        }
    ) {" "\ring: @s DOS)l     @#?t 0);
    }

#######################################################
#                                                            t ReS DOSHTML    #                ); # a, whiur    i ts exHTML    "rw"ypstringo check
#
# Read the  whiur    i t string eth exHTML    e w
   #s:nto '_'t Re S DOS:nto '_'    * (or*,dlss rturns:sagee    *f this f*,dlss rturns:sagee    *ry thf this f*,dlss rturns:sag        ..n err    *rror nthf this f*,dlss rturns:sagnge    Terifytthe r    i ts sound nprverifieb    #
k qu te#anotr w####a This fa>$sFeDetaietined n requinged
#
#####################################################?###
t ReS DOSHTML###?tBlob
    }
ele ReS DOS    $s\"") "") t Re S DOS:<BLOCKf (!N ""
            "e ReS DOS() $_[1]BLOCKf (!N "     @#?tele ReS DOS    $~ s/\rin/"") .rin""
/g     @#?tele ReS DOS    $~ s/,/\<\/B\>,/g     @#?t
        }
    ree ReS DOS);##b
def);
    }

#######################################################
Inde highlightthe s This fquinged
#
##########################################################################################################################Highlight= Wrad Chighlights
#    If the spew Wradfields HTML###s
ireMssions usimments stmarkupuhe filb
# Input:    sp' insehiddprvetional lw Wrad $fhighlight status
#        highlightsif themarkup status
#    2   highlights< $pmarkup stIn/Output: 3eldList - referelds HTMLD! needturns:    m.woale status
#        turns:caobst i-lik li'\w\w' iequinged
#
 WARNING WARNING WARNING WARNING WARNING ######################Teri
   #tole]} =imodule do
   #le rinl                        # A]} toler    iuse ss.####Te!!!! T]} =ilenaPer        exp NoeDet 11AMet partamad  Javponal lcoffee!filb    t!! ThiIf thhe      0 -self-ile totole]} =irifierun-e havg n configuhe filb            ! Tsd  Jalyopriamm< $s
#    Notyouoprview
ires 72-73ew mode Bield         t mel.#Te!!!u ("P"s'PATTERN'CODE_TO_CREATE_REPLallMENT'resi"message exploitden - is thhe  the Nobesvnumbm"sionLE qu te"    e waaded miterequinged
#
 WARNING WARNING WARNING WARNING WARNING ##########################################################################################
Highlight= Wra
   Blob
    {
#? ACTINIC::ASSERT(3#_ ==            # inchidden pargumentHighlight= Wra(ompt) {" . join(_) $_[).b ($#_)", __LINE__, __FIL  a}

s= Wra, reSf th$statnQas$rsHTMLassword)   a#)   a# Now,tHighlightthe w Wra..n e  a#)   a}
@Pd the
        @a)d)   a#)   a# Ahiur    rty seshouldneedile                    # s is usionLE-sp' inded miters)   a# Butsintsthe  whItesp' in'\w     0 -locate         #  sose lims);     in e  a#)   a}
@= Wrad=sintsth/\s+?/,
s= Wrad)   alena(@= Wra))   a   Blo  a   # Mesn'taord gin  sosl lw Wra.#Te!!!shouldn- fileusionLEilename chlo  a   # w Wradrifi Err            blems!-acter        # ort des (nookinhiuhyphenpprver Wra
      # t pag    {
alue\"  sos n aposd  phert here bag    {
    modhras'\w"\b".
      #
      # Butsxtracthe  thblemidden aor
s= Wra    iramete is ty-escaprvetiketr w##;;        HTML    e $ph- re: "O'Reilly"ilenaO'Reilly". UT.
#        {
    modXML/SGML##      #  is tbes,ametened r    HTML    "%xx"ok la.#Ben$, thi"rw"yprelotolee  "$_".
      #
      s/\'/\'/g    MORY        aposd  pher'\woesn'tld the : O'Reilly
      s/-/\-/g    MORY        hyphenr'\woesn'tld the : Difs:    -Hellman
      s/\./\./g    MORY        s);iodr'\woesn'tld the : www.a                # .cte##      s/_/ /g    MORYBu# conv No '_'is usp' in'\wld the : Big_A_Auto
      #
      # Conv N permiw=imort deanr s uconsid r: !&;:$%*
      #
                I        e - nprg_W $avoid highlightsb"rwk sos n XMLilename che is ty
                tiket"{".#Te!!!! Tmetet res);     in!-abm";"i
   #toler w##;;         nprg_Wfile to s highlightthe         #e toree
meteXML.#Teribess six##;;            eval '!!unr
  ions usigloba        er\w' inttin xFor silyeaceckthe str                    s thaoesn'tef, "rnal lins:is ty. Butsxt!!!shouldnc# loomonot ex#ew mode pame i whw     0  scri            }
        Highlights<xt< $ad $fdoubube noarbesv
#  lhw     0  scri            }


_$sVal/^\d+$/64 bits)
        # Me            # makeoubube noary!! Tmete";"it partInprg_W)
        #
          push
@Pd the
(-1,\b$_\[^;\]*?,\b(?!;)"sError);
            }
        e_ilen''64 bits)
          push
@Pd the
(-1,\b$_.*?,\b"sError);
      })   a#)   a# Orig
        T George iamm< asese\" l chanain!-aB                Birxt!!el, 11 Mey 2000me    #)   a# do                 loostuf
        assume thiliter    T qu te#stterBen' T]} =ilenamyouoASSEr)                #ih$siamm< asck t))   a#)   a# Youoaskerase #ih! -brface  a#)   a# w=imort deanr s ualtloop ovs tlnew mode p, $ESso w=isll wa, opyce  a#)   a$$rsHTML$sVal~(<s tln>.+?</s tln>)~isFIL  a}
$sOldT tlne= $1d)   a#)   a# W        # bss tute#an "untikel useg# Atoken"message fs tln. Si refee f'!' i- sY        anded miterv
#  dva reinseInde,age fsoken!shouldn)        y    e wuntikel ue w t; $#fphrabeesse are re: assum                "P"PR(!NCTTITLE"itact er lver Wr.ce  a#)   a$$rsHTML$sVas~(<s tln>.+?</s tln>)~!PR(!NCTTITLE!~gisFIL  a}
$sPd the d)   a#)   a# Tbuild the aracterab# l, i.n. w Wradd gin  sosrified wioesn'tr    rty .)   a# Tbuirrg_xw"\b$_.*?,b"FiOUNDwhiy    msse tiket"\b\w+?"dfields      0 -of)   a# w WradlenamTRACEis all we doesFor silyesixe$path escaprvenvalid char)   a#)   aesse tha$sPd the a(@Pd the
))   a   Blo  a   $$rsHTML$sVas'\>(.*?)\<'lo  a      #
        a# see WARNING ab# l..nassume t        # if thel lcodavg n config
        a# unpaSea< aaobst i-l            # inc- sionLE qu tes fielded mitervtiket"{"lo  a      #
        a# E                # extrat
            betwee#  dj' inhemarkup tagschange$1.
        a# Mins
< $pup ($1ilena") t p($1i=~ /\s/)racterPer        should
        a# valcksurIeInde-misoesn't n
#        {
    nyw    y    viae
    if (aceckthe.
        a# Si refeesume thigloba        er\w' i,         #                 e# sis potenre"rw"
        a# unpaHTML$lenae thald the p- o(nooki$#Pd the
    l l1 t p2,     f
        a# wnly   #used bmsse longen ao,age f++)        shouldneedpriansid red.
        a# en.
highlightthe,bmsse longe3 t p4useyneedunes (RE, "    nyw    y.
        a# Butsa#  dva reinseIndesrifietand esn't mnal li mun'tlargchlo  a     a# group l lld the arcouldn erro.lo  a      #
        a}
$te= $1d)   a  a   $t    $~ s/($sPd the )/reSf th$1tatnQ/gsi;lo  a      #
        a# Re-in# No xtrat
        ,amew    # mre noonly uhighlightson/off,    betwee#)
        # xtraorig
        T markup tagscrifiemarkup ded miters siorefee forig
        T)
        # his ishemis useIndelo  a      #
        a">$t<";lo  a      #
        a# see WARNING ab# l..nry thlss r! Tlds upniselo  a   'resi;age                                 # ' ##Te!!!sionLE qu tesed minpprs string  sos            blems!rifieemacs;
      })   a# Reues t xtraorig
        T s tln. Iecurt diseg#s rwh uhnd ed met!higloba    )   a# er\w' inBuath who thedetactli#  wriuniqu n ss. Buts esn'FeDeb# l.ce  a#)   a$$rsHTML$sVas~!PR(!NCTTITLE!~$sOldT tln~gisFIL  a}##########################################################################Dn paminePricesToShow -lhe kt mnamTRACEpricesis ushowd/weldList
# Re($bShowRse\"lPrices, $bShowCuuesmerPrices, $nAy the Sn'FUtil) handle
DEN ? $oki$tus : $nookibShowXXX handleval
bShowCuuesmerPrices, r wor}nAy the Sn'FUtilValue\" cosn'FUtilVID###########################################################################
Dn paminePricesToShowurePath URL
N!!!!! nwe kt mnamTRACEpricesis ushowd/l etc
    #nAy the Sn'FUtilV= -1;guh
    {bShowCuuesmerPricesny     tus : $ptD
    {bShowRse\"lPricesny     tuN ? ;##h URL
See                        sume thisuuesmerify the account}
$sDigess BStyle = $ACB2B->Get('wordDigess'ath2(@_($sDigess len''64 biode
        {
        Getpath ary_W)
    #        }

        my ($Status, $, EpBry_Wasswyle = $ACGetBry_W($sDigess,wyle = $ACGetsub (<", 0,oesn'up tth ary_W)


        if ($=tatus != $::SUCCESS)
        #)
        # Gotpath ary_WSso getpath fy the acc        #)
        }
$pAy the sError
        my ($Status, $, EpAy the asswyle = $ACGetCuuesmerAy the     retBry_W{Ay the ID},wyle = $ACGetsub (<",wn tree
            if ($=tatus != $::SUCCESre
                #
                # Gotpath fy the Sso getpath sn'FUtilV            #whe|        # ese\"lEpricesietailrown
                #
                ;
( $pAy the ->{PriceSn'FUtil}W!BS1 )         I        ese\"lE!! Tmetern our de Namee
                    #nAy the Sn'FUtilV= $pAy the ->{PriceSn'FUtil}, 0# sll wath sn'FUtil
                    #bShowRse\"lPricesny !etBry_W->{HedeRse\"lPrices};0# sll wwhe|        # wailrow ese\"lEprices
                    #bShowCuuesmerPricesny     tuN ? ;                                            #lrow suuesmeriprices
                    }ite.");
            ng
            }
        }
    rbShowRse\"lPrices, $bShowCuuesmerPrices, $nAy the Sn'FUtil)sError);
    }

###############################################################
#Vh t nt\@FieldGetpath vh t ntetionaernam        ); tdTypeHTML$lenaiamptannthe filb
#     [0]    --locate ); tdTypt - red/weldList
# Re($Vh t nt\@Fi$staLss ) handle
Vh t nt\@FieldList - referenptional lth t  argu ndle
Lss     -eHTML$lenate ); tdTyp###########################################################################

#Vh t nt\@FirePath2
    {
    e ); tRefassword) = @_;
Vh t nt\@Fi$staLss $stkesponse, $i)e tha$k (keys %,

Hash); $i--)
        {    {S    $~ /^(_?)
    e ); tRef\_/ SUCCESS)
        }
$sVh t ntSpecny     llUtilt
    {c        $nC$sVh t ntSpecny~ tr/_/_/;                     Cthe SASSEr)            es
                    {    {c        $n= 0 )last;                            N rn sos-            #te            VALUEUCCESre

Vh t nt\@Fi->[$sVh t ntSpec]ny     tu

Hash{$k}site.")taLss B.=A"<INPUT TYPE=HIDDEN AR:U=eturne ); tRefompt"_ompt"$sVh t ntSpec\"    VALUE=etutu

Hash{$k}\">"site.");
                    }
{    {c        $n= 1 )last;                # Jswortand-abmsi        to      0 UCCESre

    {
Attrictee,
    my ($sVaintst('_',$sVh t ntSpec site.")
Vh t nt\@Fi->[$sAttrictee]$nC$sVhy (site.")taLss B.=A"<INPUT TYPE=HIDDEN AR:U=eturne ); tRefompt"_ompt"$sAttrictee\"    VALUE=etun ("\"$s>"site.");
                    }}
    else                                    Msse longetand-as     lo    T attricteesv
# tandwidgetUCCESre

    @sVh SpecItems!Vaintst('_',$sVh t ntSpec site.")$i);spo=r($i <=$#sVh SpecItemsldLis=2)de Namee
                    #Vh t nt\@Fi->[$sVh SpecItemseldL]$nC$sVh SpecItemseld+1];
                    #aLss B.=A"<INPUT TYPE=HIDDEN AR:U=eturne ); tRefompt"_ompt"$sVh SpecItemseldL\"    VALUE=etun ( SpecItemseld+1]$s>"site.")    }ite.");
            ng
            }
        }
    rVh t nt\@Fi$staLss ) undef);
    }

#######################################################Cuuesmerify the ssiammst f This fsquinged
#
##################################################################################################################Cfy GetCwardes!-agetpyle = $_ACCOUNTaernayle = $_BASEcts:Acwardesd/weldList
# nput:    fy the Scwardee field #tus
#        b    0 -FILE alardee field #f OK
#
#######################################################
fy GetCwardesrePath2
    {
Cwardesernamardes_FILE__);
returt -rsswyle = $ACGetturt  -r(nst,
eturt -rss~ s/\?.*//;                                    WFileedsck t jswore sure thed filnstringfig
        }
;
( yle = $ACIeSf ticn($s(
eturt -r) )                I                i-l    $sFilcterano                ur    ific
ireM-            sume tmeteB2Bemory")
        {
        $ACB2B->C                ('B    0
'ath2(
        {
        $ACB2B->C                ('wordIDamarde'ath2(
        {
        $ACB2B->C                ('wordN$sF'ath2(
        {
        $ACB2B->Set('C                IDamarde','CLEAR'$sValC                 nticaamardeery the hah2(
        {
        $ACB2B->Set('C                nticamarde','CLEAR'$sValC                 nticaN$sFaamardeery the hah2(

        }
    r'',''", 0, 0);
rnamardesny     tuENV{' usi_COOKIE'}    MORY        trned nr
        # Retriealarde @_;
    @amarde($pPageLintst(/;/sernamardes_F 0# sehiddprpath vh tous alardee f t fileDfields o page2
    {
Label,$sDigess,$sB    0
,urne ); t
,urwordN$sF_FILE__esse tha$samardee    @amarde($pPaemory")
    samardees~ s/^\s*//;                            TMODE)    rip              tolewhIteusp' ipShop);
    amardees~ /^yle = $_ACCOUNT/Rrase)            se notr w    fy the ScwardeUCCESS)
        {
Label,
$sDigessageLintst (/=/sernamarde_F 0# r
        # Retrie field va    #)
        # )    rip ed btr\"ltoleer              tolequ te($ttinsp' isd va    #)
        $sDigess B~ s/^\s*"?//;)
        $sDigess B~ s/"?\s*$//;)
        );
            }
        elamardees~ /^yle = $_USERAR:U/)se)            se notatalhed fUCCESS)
        {
Label,
$swordN$sF_geLintst (/=/sernamarde_F 0# r
        # Retrie field va    #)
        # )    rip ed btr\"ltoleer              tolequ te($ttinsp' isd va    #)
        $swordN$sFsswyle = $ACDecodaT
        ($swordN$sFES
#                $ACFORMob{'_ENCODED);)
        $swordN$sFss~ s/^\s*"?//;)
        $swordN$sFss~ s/"?\s*$//;)
                {
        $ACB2B->Set('wordN$sF',urwordN$sF_FIL
        );
            }
        elamardees~ /^yle = $_BASEcts:/)se)            se notath a    0 -FILEUCCESS)
        {
Label,
$sB    0
_geLintst (/=/sernamarde_F # r
        # Retrie field va    #)
        # )    rip ed btr\"ltoleer              tolequ te($ttinsp' isd va    #)
        $sB    0
sswyle = $ACDecodaT
        ($sB    0
,S
#                $ACFORMob{'_ENCODED);)
        $sB    0
ss~ s/^\s*"?//;)
        $sB    0
ss~ s/"?\s*$//;)
        );
            }
        elamardees~ /^yle = $_PRODUCTPAG:/)se)        se notath                             lailrown
            S)
        {
Label,
$sne ); t
_geLintst (/=/sernamarde_F # r
        # Retrie field va    #)
        # )    rip ed btr\"ltoleer              tolequ te($ttinsp' isd va    #)
        $sne ); t
sswyle = $ACDecodaT
        ($sne ); t
,S
#                $ACFORMob{'_ENCODED);)
        $sne ); t
ss~ s/^\s*"?//;)
        $sne ); t
ss~ s/"?\s*$//;)
                {
        $ACB2B->Set('ne ); tn($s',urne ); t
 site.");
            }
;
( !$sDigess )last;                                         I                # if thno Digess                     # lhwo                uatalhth t file tgry")
        {
        $ACB2B->C                ('B    0
'ath2(
        {
        $ACB2B->C                ('wordIDamarde'ath2(
        {
        $ACB2B->C                ('wordN$sF'ath2(
        {
        $ACB2B->C                ('wordDigess'ath2(

        }
    r'',''", 0, 0);
        }
    r
sDigess,$sB    0
) undef);
    }

################################################### CAccLogi p- nticalory - B NoInvalid aseldLisval '!: Digess::MD5ilenam        sume tmetese notoutputthins:  0 -ttin xiargu     a  a   $tu

HashileedeD! needletaceessegu     a  a   $tuENV{ usi_REFERER}gu     a  a   Phr    0  e - th"rw" y - B filb    f  whiu    $sFilcterlory
ireMss  eMD5itovg n cone digessfilb            #ia< aify unpaetic. filb    n            i-l    $0 -$tu
    sB2BwordIDamarde    ttintus
_sB    0
sl        #set.####O                wi@Reaceck ACCOUNTaalardeeag\" ctuatalho pa.eldList
# ne suriguriwrits.###K
#
#######################################################
AccLogi rePath2
    {
Digess,$sB    0
,uMd5_FILE__        {
        $ACB2B->C                ('wordIDamarde'ath2(        {
        $ACB2B->C                ('B    0
amarde'ath2    }
;
( $tu

Hash{USER}    ttintus
_
Hash{HASH} )l        I                i-l    $sFilcterLOGINcatalog py")
        #
        eval 'rDigess::MD5';e);    TrnecurrtoleMD5, drop dew" gr' ifuotennamet!! TnotpathripShop);
@   mem    S)
            {
        $ACPRL =n($s(yle = $ACGetshr    0 (-1, 211,
@ , ASSERT(    tus : $ site."actt;##    tt}####        $sDigess Bntus
_
Hash{HASH}th2(
        {
        $ACB2B->Set('wordIDamarde',$sDigess)th2(
        {
        $ACB2B->Set('wordN$sF',utu

Hash{USER})th2(
        {
        $ACB2B->Set('wordN$sFamarde',    {
        $ACEncodaT
        2(tyle = $ACB2B->Get('wordN$sF'a,0))th2(
        {
        $ACB2B->Set('B    0
',yle = $ACGetturt  -r(n)th2(
        {
        $ACB2B->Set('B    0
amarde',    {
        $ACEncodaT
        2(tyle = $ACB2B->Get('B    0
'a,0))th2(
        }
        } memr})
}
$eturt -rsswyle = $ACGetturt  -r(nst,
eturt -rss~ s/\?.*//;                                    WFileedsck t jswore sure thed filnstringfig
-)
        {    yle = $ACIeSf ticn($s(
eturt -r) )                I                i-l    $sFilcterano                ur    ific
ireM-            sume tmeteB2Bemorch?
            sDigess Bn""er = '';                C                      loyrn so)
                {
        $ACB2B->C                ('B    0
'ath2(

        {
        $ACB2B->C                ('wordIDamarde'ath2(

        {
        $ACB2B->Set('C                IDamarde','CLEAR'$sValC                 nticaamardeery the hah2(

        {
        $ACB2B->Set('C                nticamarde','CLEAR'$sValC                 nticaN$sFaamardeery the hah2(
    ng
            }

            S)
        {
Digess,$sB    0
)sswyle = $AC
fy GetCwardes(_F 0# See                        euatalhooggeth exhi"rw"yh2(

        {
        $ACB2B->Set('B    0
',$sB    0
) und.");
            }__);

Samy ($Stsatus, $, EpBry_Wasswyle = $ACGetBry_W($sDigess,wyle = $ACGetsub (<", 0,oesn'up tth ary_W)


        if ($Siel, 2)###
n&& @en i        if ($Siel, NOTFOUND64 biode
        {
        Dup tth                     < ary!!nmode p, $ptiona $fhelp tth ae n ipSho        {
push
(@tu
    n($s\@Fi$sttu
    n($s\@Fi[$#tu
    n($s\@Fi]) und.;

Samy ($Stsatus, $, EsHTMLasswyle = $ACist
#ToLas=n($s(7, "<FONTaSIZ:=\"+2$s>"ule.
RequireM.    "</FONT>",wyle = $ACGetshr    0 (-1, 141),de Name
















\@tu
    n($s\@Fi$sttu
    sWebSiteUrl,de Name
















ttu
    sConh isUrl,sttu
    pSetup
, %,

Hash);lts

        if ($Siel, 2)###
R mem    S)
            {
        $ACRe
        #erminalEatus, $, yle = $ACGetsub (<",wn tr}####        yle = $ACUpdoneDiintay(EsHTML,sttu
    Orig
        T
2Exera\@tu
    n($s\@Fi",wn tactt;##    t}h2    }
;
( $sDigess && @en i        if ($Siel, NOTFOUND6 '';                Finotath atal memr})
}
$pAy the sErro
Samy ($Stsatus, $, EpAy the asswyle = $ACGetCuuesmerAy the     retBry_W{Ay the ID},wyle = $ACGetsub (<",wn t

        if ($Siel, 2)###
R mem    S)
        #)
        # Dup tth                     < ary!!nmode p, $ptiona $fhelp tth ae n ipSho    #)
        push
(@tu
    n($s\@Fi$sttu
    n($s\@Fi[$#tu
    n($s\@Fi]) und..;

Samy ($Stsatus, $, EsHTMLasswyle = $ACist
#ToLas=n($s(7, "<FONTaSIZ:=\"+2$s>"ule.
RequireM.    "</FONT>",wyle = $ACGetshr    0 (-1, 141),de Name
















 \@tu
    n($s\@Fi$sttu
    sWebSiteUrl,de Name
















 ttu
    sConh isUrl,sttu
    pSetup
, %,

Hash);lts
t

        if ($Siel, 2)###
R mem    re
                    {
        $ACRe
        #erminalEatus, $, yle = $ACGetsub (<",wn trr}####            yle = $ACUpdoneDiintay(EsHTML,sttu
    Orig
        T
2Exera\@tu
    n($s\@Fi",wn t"actt;##    tt}####        ;
( $EpAy the {        if (}W!BS0 )last;##Cuuesmerify the uris < $s chem    S)
            {
        $ACPRL =n($s(yle = $ACGetshr    0 (-1, 214, $EpAy the {Ay the N$sF} , ASSERT(    tus : $ site."actt;##    tt}##
            }
         retBry_W{        if (}W!BS0 )last# Buyerify the uris < $s chem    S)
            {
        $ACPRL =n($s(yle = $ACGetshr    0 (-1, 215, retBry_W{N$sF},$EpAy the {Ay the N$sF} , ASSERT(    tus : $ site."actt;##    tt}##
            {
        $ACB2B->Set('wordDigess',$sDigess)th2##

fy SetCceckouttrings(etBry_W, EpAy the aptD    .")
yle = $AC

    {
CuuesmerAddrtusISSEx(", 0,TbuisuuesmeriSea<xme tleft nlesslenamulti    to awritsESso                 nmet!up thripSho        }
        }
    else                                    Netese no memr})
}
$eRequireMipyle = $ACGetshr    0 (-1, 216aptD    .RecorderminsalEatus, $, yle = $ACGetsub (<",a# ercouburth e  0 -erelds e  0 -FILEUCCE    {
push
@tu
    n($s\@Fi$syle = $ACGetturt  -r(nst,  ;

Samy ($StsErn a, EsHTMLasswyle = $ACist
#ToLas=n($s(7, "<FONTaSIZ:=\"+2$s>"ule.
RequireM.    "</FONT>",wyle = $ACGetshr    0 (-1, 208),de Name
















\@tu
    n($s\@Fi$sttu
    sWebSiteUrl,de Name
















ttu
    sConh isUrl,sttu
    pSetup
, %,

Hash);lts

        if ($Siel, 2)###
R mem    S)
            {
        $ACRe
        #erminalEErn a, yle = $ACGetsub (<",wn tr}##E    {
PRL =n($s(EsHTML,sASSERT(    tuN ? ",wn tactt;##    t}h2t 0);
    }

#######################################################
#                                                            tAy CExeoogBodyeldLit
# ned fiof  (orl    $xeoog p, $phe filb
#
# are neeldList
# nut:    htmlure thed fiare lld a status
#  1    --locas$sFile th                    # if    modhrilc$sFeDeu"Inilc$sFeetile th                    # if    mod #f OK
#
#######################################################
Ay CExeoogBodyurePath
    {
ne ); tn($s    $s'    $xeoogbody.html';                        de our   amelaead/t URL
See                        # if thi  amelaea        evaessfit URL;
( $tu

Hash{PRODUCTPAG:}i=~ /\S/ SUCCEy")
    sne ); tn($s    $s$tu

Hash{PRODUCTPAG:};;
            }__);
$sFc$sFn($s    $s$sne ); tn($s;    }
;
( yle = $ACIeCExeoogFc$sFd() SUCCEy")
    sFc$sFn($s    $s'lc$sFeet.html';                    de our   amelaea!rifielc$sFe 0, 0);
        }
    r
sne ); tn($s,    sFc$sFn($s) undef);
    }

#######################################################Cfy SetCceckouttrings    --Setpath dse\"lsmessage thary_W)
####erelds cceckoutileingshe filb
nput:    Type! nery_W)
#tus
#  1    --Type! nfy the ac#f OK
#
#######################################################
fy SetCceckouttringsrePath2
    {
tBry_W, EpAy the assword) = @_;
Samy ($Stsatus, $, EpInvoiceAddrtus, EpDeli loyAddrtus, EnInvoiceAddrtusID, EnDeli loyAddrtusID);)
 URL
Setpath fddrtus IDeD! nASSERis rqu
 URLEnInvoiceAddrtusIDV= -1;guhEnDeli loyAddrtusIDV= -1;gu)
 URL

#0 -locataxilnstringfig
     URL                    # O samACP
#0 Adva reiTax();)
 URL
Setpath Compnayileings-erelds fy the ued fUCC URLEtu
    B            Conhact{'REMEMBERME'}ny     tus : $ptD     URL
Setpath Comped bleings-erelds fy the ued fUCC URLEtu
    B            Conhact{'COMPANY'}ny     pAy the ->{Ay the N$sF}FILE__);
(%Payid aInst);)
 URL
Setpath prurt  -dlldyid a methodit partgeg  sosunpate the st# er\ct e aaobst f errCe!!nmode p,yid a haseloC URLEPayid aInst{'METHOD'}n        =                     # O samACEnumToPayid aSator (    pAy the ->{De our Payid aMethod});)
 URL
Cceck                        eufy the ue sury   #s k li'\voice fddrtusfit URL;
(    pAy the ->{InvoiceAddrtusRtil}Wn= 1SUCCEy")
    nInvoiceAddrtusIDV=     pAy the ->{InvoiceAddrtus}FILE__LEtu
    B            Conhact{'AR:U'}        =     pAy the ->{N$sF}FIL_LEtu
    B            Conhact{'SALUTATION'}=     pAy the ->{Saluaaobst}FIL_LEtu
    B            Conhact{'JOBTITLE'}    =     pAy the ->{T tln}FIL_LEtu
    B            Conhact{'PHONU'}        =     pAy the ->{Telephk lNurns:}FIL_LEtu
    B            Conhact{'FAX'}            =     pAy the ->{FaxNurns:}FIL_LEtu
    B            Conhact{'EMAIL'}        =     pAy the ->{E (olAddrtus}FIL(
        }
        } memr})
;
(    pBry_W->{InvoiceAddrtusRtil}Wn= 0R mem    S)
            nInvoiceAddrtusIDV=     pBry_W->{InvoiceAddrtusID};##    tt}####        $tu
    B            Conhact{'AR:U'}        =     pBry_W->{N$sF}FIL_LEtu
    B            Conhact{'SALUTATION'}=     pBry_W->{Saluaaobst}FIL_LEtu
    B            Conhact{'JOBTITLE'}    =     pBry_W->{T tln}FIL_LEtu
    B            Conhact{'PHONU'}        =     pBry_W->{Telephk lNurns:}FIL_LEtu
    B            Conhact{'FAX'}            =     pBry_W->{FaxNurns:}FIL_LEtu
    B            Conhact{'EMAIL'}        =     pBry_W->{E (olAddrtus}FIL(
        }
 URL
I                #kmew    unpaSevoice fddrtus populdprpath haseeserified wi ddrtusfit  dse\"lsfit URL;
(    nInvoiceAddrtusIDV!= -1SUCCEy")
;
Samy ($Stsatus, $, EpInvoiceAddrtusassw)
            {
        $ACGetCuuesmerAddrtus(    pBry_W->{Ay the ID},w    pAy the ->{InvoiceAddrtusID},wyle = $ACGetsub (<",wn t

        if ($Siel, 2)###
R mem    S)

        }
    ) und.");
    Etu
    B            Conhact{'ADDR#
1'}        =     pInvoiceAddrtus->{Lss 1}FIL_LEtu
    B            Conhact{'ADDR#
2'}        =     pInvoiceAddrtus->{Lss 2}FIL_LEtu
    B            Conhact{'ADDR#
3'}        =     pInvoiceAddrtus->{Lss 3}FIL_LEtu
    B            Conhact{'ADDR#
4'}        =     pInvoiceAddrtus->{Lss 4}FIL_LEtu
    B            Conhact{'COUNTRY'}        =     {
        $ACGetCthe ryN$sF(
InvoiceAddrtus->{Cthe ryCode})th2(
    tu
    B            Conhact{'POSTALCODE'}    =     pInvoiceAddrtus->{PostCode};de
        {
        New    #etpath Sevoice     #
obst instringfig

        {
    tu
    L#
obstInst{INVOICE_COUNTRY_CODE}    =     pInvoiceAddrtus->{Cthe ryCode};    {
    tu
    L#
obstInst{INVOICE_REGION_CODE}        =     pInvoiceAddrtus->{        ifeCode};de
        {
        New    #etped btaxiexame bst to t mem#})
;
(    tu
    pTaxSetup
{TAX_BY}W!BS2R mem    S)
            tu
    TaxInst{'EXEMPT1'}n    =     pInvoiceAddrtus->{Exame Tax1}Wn= 0 ?i$tus : $n:     tuN ? ;##h            tu
    TaxInst{'EXEMPT2'}n    =     pInvoiceAddrtus->{Exame Tax2}Wn= 0 ?i$tus : $n:     tuN ? ;##h        ;
(    tu
    TaxInst{'EXEMPT1'}R mem    re
                    tu
    TaxInst{'EXEMPT1DATA'}n    =     pInvoiceAddrtus->{Tax1Exame 2Exe}site.");
            ;
(    tu
    TaxInst{'EXEMPT2'}R mem    re
                    tu
    TaxInst{'EXEMPT2DATA'}n    =     pInvoiceAddrtus->{Tax2Exame 2Exe}site.");
            }##    t}h2    }
;
(    pBry_W->{Deli loyAddrtusRtil}Wn= 0R memy")
    nDeli loyAddrtusIDV=     pBry_W->{Deli loyAddrtusID};##    t;
Samy ($Stsatus, $, EpDeli loyAddrtusassw)
            {
        $ACGetCuuesmerAddrtus(    pBry_W->{Ay the ID},w    pAy the ->{Deli loyAddrtusID},wyle = $ACGetsub (<",wn    {
    tu
    ShipConhact{'AR:U'}        =     pBry_W->{N$sF}FIL_LEtu
    ShipConhact{'SALUTATION'}=     pBry_W->{Saluaaobst}FIL_LEtu
    ShipConhact{'JOBTITLE'}    =     pBry_W->{T tln}FIL_LEtu
    ShipConhact{'PHONU'}        =     pBry_W->{Telephk lNurns:}FIL_LEtu
    ShipConhact{'FAX'}            =     pBry_W->{FaxNurns:}FIL_LEtu
    ShipConhact{'EMAIL'}        =     pBry_W->{E (olAddrtus}FILIL_LEtu
    ShipConhact{'ADDR#
1'}        =     pDeli loyAddrtus->{Lss 1}FIL_LEtu
    ShipConhact{'ADDR#
2'}        =     pDeli loyAddrtus->{Lss 2}FIL_LEtu
    ShipConhact{'ADDR#
3'}        =     pDeli loyAddrtus->{Lss 3}FIL_LEtu
    ShipConhact{'ADDR#
4'}        =     pDeli loyAddrtus->{Lss 4}FIL_LEtu
    ShipConhact{'COUNTRY'}        =     {
        $ACGetCthe ryN$sF(
Deli loyAddrtus->{Cthe ryCode})th2(
    tu
    ShipConhact{'POSTALCODE'}    =     pDeli loyAddrtus->{PostCode};de
        {
        New    #etpath deli loy     #
obst instringfig

        {
    tu
    L#
obstInst{DELIVERY_COUNTRY_CODE}    =     pDeli loyAddrtus->{Cthe ryCode};    {
    tu
    L#
obstInst{DELIVERY_REGION_CODE}    =     pDeli loyAddrtus->{        ifeCode};de
        {
        New    #etped btaxiexame bst to t                        'rcatax sosby deli loy  ddrtusfitm#})
;
(    tu
    pTaxSetup
{TAX_BY}W=BS2R mem    S)
            tu
    TaxInst{'EXEMPT1'}n    =     pDeli loyAddrtus->{Exame Tax1}Wn= 0 ?i$tus : $n:     tuN ? ;##h            tu
    TaxInst{'EXEMPT2'}n    =     pDeli loyAddrtus->{Exame Tax2}Wn= 0 ?i$tus : $n:     tuN ? ;##h        ;
(    tu
    TaxInst{'EXEMPT1'}R mem    re
                    tu
    TaxInst{'EXEMPT1DATA'}n    =     pDeli loyAddrtus->{Tax1Exame 2Exe}site.");
            ;
(    tu
    TaxInst{'EXEMPT2'}R mem    re
                    tu
    TaxInst{'EXEMPT2DATA'}n    =     pDeli loyAddrtus->{Tax2Exame 2Exe}site.");
            }##    t}h2
 URL
sll wath turns:    m to t meount}
    {
            @Resp                    # O samACGetCar ID(yle = $ACGetsub (<",a# er
        # Retriea theID##t

{
            @Rose$Siel, 2)###
R                                    e  0 -out memr})
        {
        r@ge) = @Rns##    t}h2

    {
Car IDassw
{
            @Ro2]    ##        {
            @Resp                    # O samACSll CceckoutSamy ((yle = $ACGetsub (<sernaar ID, \%tu
    B            Conhact,de Name




\%tu
    ShipConhact, \%tu
    ShipInst, \%tu
    TaxInst, \%tu
    G n colInst,de Name




\%Payid aInst, \%tu
    L#
obstInst) undef);
    }

################################################### CAccFinontica- sinotooggeth exatalhssionscwardeUCB NoInvalid aseldList
# nnticaDigess 0 -""ree
metese notoruris < $s chOK
#
#######################################################
Ay FinonticrePath2
    {
Digess,$sB    0
)sswyle = $AC
fy GetCwardes(_F # See                        euatalhooggeth exhi"rw"y     le
    #
sDigess) memr})
        {
        r"");;
            }__);

Samy ($Stsatus, $, EpBry_Wasswyle = $ACGetBry_W($sDigess,wyle = $ACGetsub (<", 0,oesn'up tth ary_W)


        if ($Siel, 2)###
) mem r})
         {
        r"");;
             }__);
$pAy the sErr
Samy ($Stsatus, $, EpAy the asswyle = $ACGetCuuesmerAy the     retBry_W{Ay the ID},wyle = $ACGetsub (<",wn

        if ($Siel, 2)###
) memr})
        {
        r"");;
            }__);
( $EpAy the {        if (}Wn= 0 && @en ietBry_W{        if (}Wn= 0 )last;
Cceck                fy the u thi            ve tgry")
        {
        $ACB2B->Set('B    0
',$sB    0
) und.
        }
    r
sDigessilename);;        Fe notldLit
# digessfi
            }__)        {
        r"");;
ef);
    }

################################################### P
#0 XML    #    PXML    wrap <W)
#tPrehid  e asicoth t fileDernam
#0 sat
            ssionsyle = $_PXML###sAer of a:    --ly theoam
#0 heck
#
# Re- P
#0 d-ly tchOK
#
#######################################################
P
#0 XMLurePath
    {
HTML$s $nam =unt}
$sDigess BStyle = $ACB2B->Get('wordDigess'ath2    }
;
( !$sDigess )lB NoIatal memr})
$sDigess BStyle = $ACB2B->Set('wordDigess',yle = $AC
Ay Finontic(<",L
See                        # if thi atalhalardeea partall##    t}h2    }
;
( $sDigess )                nticafe notlddo ssmee asicoXML    th t file tgry")
;

Samy ($Stsatus, $, EpBry_Wasswyle = $ACGetBry_W($sDigess,wyle = $ACGetsub (<", 0,oesn'up tth ary_W)


        if ($Siel, 2)###
R mem    S)
            {
        $ACRe
        #erminalEatus, $, yle = $ACGetsub (<",wn tr}####        }
$pAy the sErro
Samy ($Stsatus, $, EpAy the asswyle = $ACGetCuuesmerAy the     retBry_W{Ay the ID},wyle = $ACGetsub (<",wn t

        if ($Siel, 2)###
R mem    S)
            {
        $ACRe
        #erminalEatus, $, yle = $ACGetsub (<",wn tr}####        }
$sBuyeri= retBry_W{N$sF};##        }
$sAy the i= retAy the {Ay the N$sF}th2(
        {
        $ACB2B->SetXML('BUYER',  a   $sBuyer)th2(
        {
        $ACB2B->SetXML('ACCOUNT',  a $sAy the )th2(
        {
        $ACB2B->SetXML('NOWSERVING',wyle = $ACGetshr    0 (-1, 212, $sBuyer))th2(
        {
        $ACB2B->SetXML('CURRACCOUNT',yle = $ACGetshr    0 (-1, 213, $sAy the )M.    "<                    # :LOGOUT_SIMPLE/>")th2(
        {
        $ACB2B->SetXML('WELCOME',  a yle = $ACGetshr    0 (-1, 210, $sBuyer))th2h2(
        {
        $ACB2B->SetXML('LOGOUT', "</TR><TR><TD ALIGN=RIGHT>" @en M.    "<     HREF=etutu
    sAy the Sn our\?    {
ON=LOGOUT"ule($tu

Hash{SHOP} ?i"&SHOP="ule    {
        $ACEncodaT
        2(ttu

Hash{SHOP}T(    tus : $ n: a") .    "\" TARGET=et_hid nt$s>"wn trM.    "<"
        de Nam. yle = $ACGetshr    0 (-1, 217   mem    n M.    "</B></A></TD>")th2(
        {
        $ACB2B->SetXML('LOGOUT_SIMPLE', de Name



i" <     HREF=etutu
    sAy the Sn our\?    {
ON=LOGOUT&PATH=$tu

Hash{PATH}\" TARGET=et_hid nt$s>"wn trme



i. yle = $ACGetshr    0 (-1, 217   mem    ne



i. "</A>");;
            }__);
$pXML$s  - tyle = $_PXML(_F # C"rwtodXML obj in e__)        {
        $pXML->P
#0 (EsHTML_F 0#
#0 -l
            ttin        {
    ;
ef)

###########################################################
ick($s    yle = $_B2BtldkeepseB2B    th t file t# #Te!!!obj indkeepseB2B    th t fileate virtoleSet,lC                 ttinGetErt af This fsequi aSetXML,wyp < $XML,wGetXML ttinC                XML tre his is_);
sse essage  er
        # ReXML tag    th t fileahis ibytyle = $_PXML clats.###sageeRysze stZyb No  Mnas17 12:11:17 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as
ick($s    yle = $_B2B;;
rCe!;
    no;f)

###########################################################
###
 - t- c"rwtodB2B    obj ind###sageeRysze stZyb No  Mnas17 12:11:50 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
 - turePath
    {Proto s $nam =unt}
$Clorrny ref({Proto) ||    {Proto=unt}
$Self#ny {}th2(files
    elf,
$Clorrath2(        elf->{XML}ny {}th2__)        {
        $    elf;;
ef)

###########################################################
B2B->Setd-as    teB2B    th t fil###
Avalid aseld    Paramalorreld    P1    --th t filued fUC#us2eldth t filu field #tu
#
# eld    Paramth t filu field #tusageeRysze stZyb No  Mnas17 12:14:43 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
SeirePath2
    $Self#s $nam =unt}
$sN$sFssw$nam =unt}
$s ("\"ssw$nam =unh2(        elf->{$sN$sF}$nC$sVhy (site        {
        $sVhy (siteef)

###########################################################
B2B->C                 - uns    teB2B    th t fil###
Avalid aseld
         aramalorreld
         1    --th t filued fUC#sageeRysze stZyb No  Mnas17 12:19:09 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
C                rePath2
    $Self#s $nam =unt}
$sN$sFssw$nam =unh2(        elf->{$sN$sF}$nCASSERsiteef)

###########################################################
B2B->Getd-ag    teB2B    th t fil###
Avalid aseld

         aramalorreld

         1    --th t filued fUC#tu
#
# eld

         aramth t filu field #sageeRysze stZyb No  Mnas17 12:20:48 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
GeirePath2
    $Self#s $nam =unt}
$sN$sFssw$nam =unt        {
        $    elf->{$sN$sF};;
ef)

###########################################################
B2B->SetXML    #    s    teB2B    XML    th t fil###
Avalid aseld    Paramalorreld    P1    --th t filued fUC#us2eldth t filu field #tu
#
# eld    Paramth t filu field #tusageeIfmth t filu, thi"rw"ypSERis rimodule dh sos nddLit
# nins:mpty
#
#    rty .) #
Updone    shouldneedhis is_)ile toracter sosth t file t#sageeRysze stZyb No  Mnas17 12:14:43 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
SeiXMLurePath
    {Self#s $nam =unt}
$sN$sFssw$nam =unt}
$s ("\"ssw$nam =unh2(        elf->{XML}->{$sN$sF}$nC$sVhy (site        {
        $sVhy (siteef)

###########################################################
B2B->yp < $XMLt:    fp < $ead the s_)B2B    XML    th t fil###
Avalid aseld
         aramalorreld
         1    --th t filued fUC#
         2eldad the s_)fp < $UC#tu
#
# eld
         aram - tth t filu field #sageeRysze stZyb No  Mnas17 12:19:09 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
yp < $XMLurePath
    {Self#s $nam =unt}
$sN$sFssw$nam =unt}
$s ("\"ssw$nam =unh2(        elf->{XML}->{$sN$sF}$.nC$sVhy (site        {
        $    elf->{XML}->{$sN$sF}siteef)

###########################################################
B2B->GetXMLt:    g    teB2B    XML    th t fil###
Avalid aseld

         aramalorreld

         1    --th t filued fUC#tu
#
# eld

         aramth t filu field #sageeRysze stZyb No  Mnas17 12:20:48 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
GeiXMLurePath
    {Self#s $nam =unt}
$sN$sFssw$nam =unt        {
        $    elf->{XML}->{$sN$sF}siteef)

###########################################################
B2B->C                XML -                     # lhwB2B    XML    th t file t#sageeRysze stZyb No  Mnas17 12:23:28 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
C                XMLurePath
    {Self#s $nam =unt        elf->{XML}ny ASSERsiteef)f)

###########################################################
PXML.pm    #        seudo    XML    m
#0 r t#sageeRysze stZyb No  Nov 28 09:30:40 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd 1999mes##

#####################################################as
ick($s    PXML;;
rCe!;
    no;f)

###########################################################
PXML-> - () -     on;
uct0 -FenaPXML clats###
A  loy r    iuse s     on;
uct0 . Ahi #s inherita re.) #
e Res
Sei() a This fapa#  soset# lhwd wi valid asequi aSowd wi valid asuseyneedIf the spe    # ifrifieed f=> field #tupairs t pageyuseyneedI    teldprlhssionsSei() methodequi aNoInvalid as tre obligat0 y!!nm - () cter lhw valid asusussfilbneedIf the spebeesse P
#0 () method !!!u (dequi aF
   #tolenvalid as tre     eval 'd:sageeIDus
#  => prurixew moagsc! need- filed (ituseyneedIf the spe!nmP
#0 ())sageeoag1
#  => List - referea This fa $fh fileu<IDoag1>sageeoag1_E $e=> List - referea This fa $fh fileu</IDoag1>sagee..n er aSs thhe oe bstahw valid as:sageeDEFAULT  => List - refereaea This fah filtoleunercognised status
#       oagsc(rifieprurixeIf the spe!nmID)sageeXMLERROR => ermin mequireMeoamRL =wwhen    m
#0 r dseectthins:  0  status
#       Embedoonl%s#                 eedpr\w' i ibytlocatagdlenamTRACEins:  0  status
#       phradseect(dequi aaaaaaaaaaaaaDe our : "ermin m
#0toleXML t
            (%s)"sageeIfmDEFAULT e tmeteIf the spe        euankmewn oagsctre pa# s is_sageeoutputuanch fg requinge aSments sta This faseynin meynmetebe difst - o,age foagnge aed fianotath IDutre pa# s is_re sur This fequi aSee iamm< asFenaP
#0 ().###sageeRysze stZyb No  Dec  1    18:15:36 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd 1999mes##

#####################################################as#####
 - turePath
    {Proto s $nam =unt}
$Clorrny ref({Proto) ||    {Proto=unt}
$Self#ny {}th2(files
    elf,
$Clorrath2(        elf->{XMLERROR}ny "ermin m
#0toleXML t
            (%s)"th2(        elf->{LoopProtect}ny 25000th2(        elf->{Cur - oLoop}ny 0th2(        elf->Sei(@__FIL#    u{
alur    iut V N per => '4';__)        {
        $    elf;;
ef)

###########################################################
PXML->Sei() #    s    tealufiguconfigchidden pas t#sageeRysze stZyb No  Nov 28 09:34:32 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd 1999mes##

#####################################################as#####
SeirePath2
    $Self#s
#  = $nam =unt}
%Pidden passsword) = URL
Sehiddprph fileraracterhidden pas amdm                eaehaseloC URLesse tha(keys %Pidden pas); $i--)
        {    ref({Pidden pas{$_})ilenaCODE" )lB T"rwtr lhwf This fsue wtagdh filerar(     0 -sensi        veR mem    S)
                elf->{Tags}->{uc($_)}$nC$Pidden pas{$_};##    tt}##
            }e    else                                    Anyrn so         }ef thi hidden par(     0 -sensi        veR mem    S)
                elf->{$_}$nC$Pidden pas{$_};##    tt}##
    })
ef)

###########################################################
PXML->P
#0 () -    m
#0 -ly tchOtusageeNOTE: Ituseyneed whieddLicuN pvely
####

Avalid as:    arly theoam
#0 hec                    1 (oe bstah) IDu-eprurixeeoaoesn'f0  statu
#
# Re am
#0 d-ly tchOtusageeWhen    awtagdisafe no,aoesnsmessage f< $-tagdanotc Res
f This fsageemTRACEihradsclars is_rdthe rified i wtag. t# #Terat
            betwee# if th-tagdanot< $-tagdef, "rseddLicuN pvely
# #Tern (ifpSERis r)ea This fah fi so $tag.'_E $' i-l    whied. t# #Abbrevipprvesyntax: <tag/>u thi    cept(dequi aPidden passtre parseddernam
# s iaseaehase List - referer w##i ah filer (hidden parrifi Err fielu th#etpao 'SET'64 ####
Tagdh fil so a This fai-l    whied!rifielivew valid as:sag            tag                -wtagded fUC#us\$sT
                    -wList - referer
            fe notbetwee# if thdanot< $foagnge

\%Padden pas    -wList - referehidden parhaseloe

ID                    -wprurixeessage thrunsag            eSf thTag        - fuoter
            w mif thdoagngesageeItuseyn        {
        ly theoagoheoaoutputuanotseynals_)ile torr w##i at
            betwee# oagscbeesse et!! Tparseddfur        # ngesageeIft< $-tagdh fil so a This fai-lSERis rir woret!! T    whiedsageea parttriealnh iss!! Tparsed.sageeIftmete-ret!de our s-erelagdh fil so a This f.sageeE $-tagdh fil so a This fai-l    whied!rifielocas$sFinvalid aseldLue wtagdh fil so a This factere suryrg 0, 3uanot4sl        #set.######
TageDernaIDutre      0 -sensi        vequi aPidden passn$sFeDere his iinehase anch fg rngesageeIftlocatagdh fil so a This fai-lmetern is rir wo:sageeIfmDEFAULT a This fai-lSERis ri-ret!! T    whiedsageeIfmDEFAULT_E $ea This fai-lSERis ri-ret!! T    whiedeessaE $-tagsageeO                wi@Relocatocatagd! Tpa# s i fa $foutputuanch fg requinge aRysze stZyb No  Nov 28 14:40:12 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd 1999mes##

#####################################################as#####
P
#0 hePath2
    $Self#ss $nam =unt}
$sT
        ss $nam =unt}
$sId#  = $nam =un    }
;
( !$sId#) {
$sId#=    $    elf->{ID}; }                        IDuhidden par!!!oe bstahwthripSh}
$Resur =unh2(        elf->{Cur - oLoop}++;    }
;
(         elf->{Cur - oLoop}n>         elf->{LoopProtect}nR memy")
    Resur #=    $    elf->{XMLERROR};")
    Resur #=~ s/\%s/InupniprpLoop \(\?\)/ und.
        }
    $Resur =un    t}h2
 URL
T    sume tw    # ifm
#0tolei-lS neelL
To ch fg tw    a u thi        #what!! Tnotpi    cept(d/proritsrvenvafg tr w##t# ergul             x\ct  per below -le reen aoact ur s-ere his ibelowESso##t# ifpbracke s-ere adoon/removeo,a                esureen aoaf
   #tolecodavg tsfit  sixe$.h2
 URLmTRle         rsT
        ss~ /  mem      (e                                    Sf thdoag lse                            ($1R mem    r<  mem    n\s*                                    Po  pfiluwhIteusp' i atpath a gin  soite.")taId                                    Ia< aifi_W)

        ([0-9a-zA-Z_]+?)se)        Tag    ed fi    lse                            ($2)(his R mem    r(e                                    Oe bstahwhidden partiona                        ($3)(his R mem    r (\s+                                    Pidden parif tharactersp' i                    ($4R mem    r  [0-9a-zA-Z_]+?                    Pidden pared fUCCES      (\=                                    Pidden par fielurifieequahwsign            ($5)de Name(                                    Pidden par fielse                            ($6)de Name (\"[^\"]+\") |                Pidden par fieluinedoubLE qu tes             ($7)de Name (\'[^\']+\') |                Pidden par fieluinesionLE qu tes             ($8)de Name ([^\"\'\ \/\>]+)                Pidden par fielurifi Errqu tes             ($9)de Name)    UCCES      )*?                                    Vfielu thoe bstahw(de our   th'SET'64 CES     )*?                                    Pidden passtre oe bstah4 CES    )  mem    n\s*                                    Po  pfiluwhIteusp' i mem    r(\/*?)                                Oe bstahwEnotserk e                            ($10)(his R mem    r\s*                                    Po  pfiluwhIteusp' i atpath eno mem        > mem      ) mem      | (<!--.*?-->)last# Or iamm< aslse                            ($11)(his R mem      /sx )  memr})
$sT
        s ny     ll            TMODE)nam  tth arfst  poinh r")
    Resur #.nC$`l            TMODEadore surrlnhwhidn e__)
        {
        Camm< a d-ly t!! Tnotpproritsrv    {
        Usupotenge thjsworsll she ha. Buts-le reen aoaifph filerarhll wsid  efstctsfitm#ir woret!seynmd theeaebet!ssse ef you iamm< as ErrXML tagsfitm#iTo ch fg tn aoa-msi        ty iamm< as Erriamm< asdseectper lss ractererg    x\Deb# lfitm#})
;
( $11 R                                        f  amm< as-Tpa# set# ume  mem    S)
            Resur #.nC$&;                            Add  amm< a-dlldthdanotalnhineld va    ry t; ##    tt}##
    ##        }
$sTag                    =     2;                    tagded fUC        }
$sPidden paT
            =     3;                    hidden partionUC        }
$sInsid T
                Bn""er =#at
            betwee# if thdanot< $f(:mptyeessanow)UC        }
$sSf thTag            nC$&;            #aiampleteusf thdoagng        }
$sEnoTag;                                    iampleteu< $foag (e dh sosyet)UC        }
$Pidden paHash;                            hase w mhidden pas (e dh sosyet)UC__)
        {
        I                # if    modhidden pas                 eaehaseloCm#})
;
( $sPidden paT
         SUCCESS ##    tt$Pidden paHash#=    $    elf->P
#0 Pidden pas($sPidden paT
        ) und.");
    __)
        {
        I        notp'abbrevipprvesyntax'aoesn'f0 t< $-tagloCm#})
;
( !$10#) {
$sInsid T
         #=    $    elf->FinoEnoTag(taId,$sTag,\$sT
        ,\$sEnoTag); );
    __)
        {
        I        tagdh filernin DEFAULT SERis r,  whiuit,wo                wi@Rejswor        {
        lhluwhol -ly tch
        Inped b     0 ,    m
#0 -lerat
            LicuN pvely

        ng        }
$sG n colTagd= uc($sTag);})
;
( !SERis r(        elf->{Tags}->{$sG n colTag})#) {
$sG n colTagd= 'DEFAULT' }####        ;
( SERis r(        elf->{Tags}->{$sG n colTag})#)se)        Tagdh filernse no memSS ##    tt#)
        # C lhwdagdh filernernam
#0     ly the aoaior        {
    sacc        #)
        }
$sRr\w' i =    &{        elf->{Tags}->{$sG n colTag}}(de Name













$sTag,                            Tagded fUC        ame













\$sInsid T
        ,                Rist - referer
            betwee# oagsde Name













$Pidden paHash,                Rist - referehase w mhidden pasde Name













$sId,last;##Cur - otPresixde Name













$sSf thTag            # Fuoter
            w mif thdoagng Name












 )th2h2(

;
( $sRr\w' i eq
$sSf thTag R                                    Trned navoi iinupniprpoespsde Nam{
    else                                    I        noth sosch fg r,lS n'tam
#0     ag\" ite.")tResur #.nC$sRr\w' isite.");
                    }} mem    re
                    Resur #.nC$    elf->P
#0 ($sRr\w' i,$sId)site.");
            #)
        #
#0 -l
            betwee# if th-tagdanot< $-tagd va    #)
        $Resur #.nC$    elf->P
#0 ($sInsid T
        ,$sId)site."h2(

;
( SERis r(        elf->{Tags}->{$sG n colTag.'_END'})#)s#eE $-tagd-  whiuh filernernam
#0             {
     d-ly tchem    re
                    sRr\w' i = &{        elf->{Tags}->{$sG n colTag.'_END'}}('/'.$sTag,n"",n"",n$sId, $sEnoTag);ite.");
                    }}
    else
        # De our   oelocas$sFinsmif thdoagng Name
                    sRr\w' i = &{        elf->{Tags}->{$sG n colTag}}('/'.$sTag,n"",n"",n$sId, $sEnoTag);ite.");
h2(

;
( $sRr\w' i eq
$sEnoTag )last;                # Trned navoi iinupniprpoespsde Nam{
    else                                            I        noth sosch fg r,lS n'tam
#0     ag\" ite.")tResur #.nC$sRr\w' isite.");
                    }} mem    re
                    Resur #.nC$    elf->P
#0 ($sRr\w' i,$sId)site.");
            }##
            }e    else                                    Nouh filernernano!de our ,ejsworp
#0 -l
            betwee# oagsde Na{    )
        $Resur #.nC$sSf thTag .C$    elf->P
#0 ($sInsid T
        ,$sId)ule.
EnoTag;
            ng
            }
        }
 $Resur #. $sT
                #
yp < $# lhwd wireonal lly t!!        no!ssse oagsde ef)

###########################################################
PXML->FinoEnoTag()a- sinote $-tagsagee
Avalid as:  a $sIri-rcur - otID##i aaaaaaaaaaaaa
$sTag -wtagded fUC# aaaaaaaaaaaaa
\$sT
         -wList - referer
            eoaoesn'y - B aaaaaaaaaaaaa
\$sEnotldList - refere< $foag (pnipiaty :mpty)sagee rsT
        s! T    h fg ris_);
 thda parttriee $-tagsagee

#
# Rer
            fe notbefsse loiee $-tagsagnge aRysze stZyb No  Nov 28 14:42:23 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd 1999mes##

#####################################################as#####
FinoEnoTagurePath
    {Self#s $nam =unt}
($sId, $sTag,n$sT
        ,e.
Enoassword) =__);
( $EsT
        ss~ / < \s* \/ $sIri$sTag \s* > /sx )        #
Lesn'f0 t< $-tagloCmr})
$$sT
        ss     ll            TM# T
            t part< $foagng
$$sEnot nC$&;                            T
            w m< $foagng

        }
 $`l            TMODET
            betwee# if th-tagdanot< $-tagd va        }
        }
    else                Netese notldLit
# :  0 -ttinanch fg r-ly tchemr})
}
$eErr#=    $    elf->{XMLERROR};")
    eErr#s ny~ s/\%s/$sIr$sTag/ und.
        }
    $eErr#. $EsT
        ;##    t}h2t 0)

###########################################################
PXML->P
#0 Pidden pas() -    m
#0 -hidden partionUCr aSslitswhidden partionaanotsekeseaehaseloOtusagee
Avalid as:    pidden parif the (mswors
 thdrifiewhIteusp' i)sagee

#
# R    hidden parhasedList - resagnge aRysze stZyb No  Nov 30 10:47:24 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd 1999mes##

#####################################################as#####
P
#0 Pidden pasde ath2
    $Self#s
#  ss $nam =unt}
$sPidden passsw$nam =untath
    {Pidden paHash#=        ) und    }
 URL
IMPORTANT:URL

#den parif the if tharIMMEDIATELY    t partercognised TAGURL
So:aiorMUSTrs
 thdacterwhIteusp' i me URLmTRle         rsPidden passs~ m/\G  mem      \s+                            t# Obligat0 y!whIteusp' i mem      ([0-9a-zA-Z_]+)                        Pidden pared f ($1R mem      (\= mem    r(e mem    r (\"[^\"]+\") |                    Pidden par fieluinedoubLE qu tes mem    r (\'[^\']+\') |                    Pidden par fieluinesionLE qu tes mem    r ([^\"\'\ \/\>]+)                    Pidden par fielurifi Errqu tes4 CES    )                                        Pidden par fielu($3) mem      )*                                        '= fiel' meynmetebe         # if($2) mem      /gsx )chemr})
}
$eN$sFssw$1;})
;
( $2 )                                        T    # if thi  field va    {)
        }
$s ("\"ssw$3;)
        $s ("\"ss~ s/^(\"|\')//;            Rimove              tolequ te)
        $s ("\"ss~ s/(\"|\')$//;            Rimove tr\"ltolequ te)
        $Pidden paHash->{$sN$sF}$nC$sVhy (site        }##
            }e    else                        Nou fiel,h#etpitpao 'SET' mem    S)
            Pidden paHash->{$sN$sF}$nC'SET';
            ng
            }
        }
 $Pidden paHash;iteef)f)

###########################################################
ick($s    yle = $_PXML - yle = $eIf the c    m
#0 r t#
T    sume tapprotype'f0 tdevelopid a###sageeRysze stZyb No  Dec  7 20:52:23 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd (1999)#####

#####################################################as##
ick($s    yle = $_PXMLFIL#u{
alur    iut V N per => "1.0, (PXML: "ulePXML->V N per . ")"th2;
rCe!v
#0 qw(@ISA) un@ISA$nCqw(PXML)th2h2###
 - turePath
    {Proto s $nam =unt}
$Clorrny ref({Proto) ||    {Proto=unt}
$self#ss $Clorr->SUPER:: - ();    else                                            dlnhwhissinvalid as,            #caexatasSei()und    }
files
self,
$Clorrath2(h2(    self->Sei(UCCES      ID                        =>    '                    # :',else                                            de our  presixde Nam  MAINFRAME                =>    ###
{     self->M\" Fc$sFTagH filer(@__
        ,                hafileuurliof  (orllc$sFde Nam  PRICES                    => ###
{     self->PricFTagH filer(@__

        ,                pricFdoagng NameeRETAIL_PRICE_TEXT    =>    ###
{     self->Rse\"lPricFT
        TagH filer(@__    ,                rse\"l    pricFdo
            eagng NameeVAR                        => ###
{     self->VarTagH filer(@__

        ,                v
#    eagng NameeSE{
ON                => ###
{     self->SectperTagH filer(@__

    ,                sectper eagng NameeADDR#
ES                => ###
{     self->AddrtusTagH filer(@__

    ,                 ddrtuses eagng NameeUNREG                    => ###
{     self->UnregTagH filer(@__

        ,                unergioners iatalheagng NameeIGNORE                    => ###
{     self->IgnsseTagH filer(@__

    ,                IGNOREfoag (deletesat
        R mem    r  NOe =B2B                => ###
{     self->NetInB2BTagH filer(@__

    ,                NOe =B2Bfoag (deletesat
        R mem    r  DEFAULT                => ###
{     self->De our TagH filer(@__

    ,                ankmewn oagscthripSho    r  XMLERROR                => "<br><flnhwsize=+2
allor=rs ><b>". yle = $ACGetshr    0 (-1, 218)M.    "</b></flnh><br>",4 CES     );h2(    self->Sei(@__FIL.
        }
    $eelf;;
ef)

###########################################################
AddrtusTagH filerd-  whibick'f0 t ddrtusesUC#tu
\w' is <                    # :ADDR#
ES/>foag by  ddrtusfoafil###
###
Avalid asn:     sTag -wtagded fUC# aaaaaaaaaaaaa$sInsid T
         -wList - referer
            betwee# if thdanot< $,UC# aaaaaaaaaaaaa$Pidden paHash#-ehase w mhidden pas,UC# aaaaaaaaaaaaa$sIri-rcur - ottagdpresix,UC# aaaaaaaaaaaaa$sFuotTag -wfuoter
            w mcur - ottag;UC#tu
#
# aaa:  ddrtusfoafil###sageeRysze stZyb No  Jaex 3 16:44:37 GMT 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
yddrtusTagH filerurePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sId, $sFuotTagassword) = @_$sDigess BStyle = $ACB2B->Get('wordDigess'ath2    }
;
(     sTag !~ /^\// )last;                se                                            Ignsset< $-tage tgry")
;

Samy ($Stsatus, $, EpBry_Wasswyle = $ACGetBry_W($sDigess,wyle = $ACGetsub (<",wn t

        if ($Siel, 2)###
R mem    S)

        }
    r"");;
        ng
    }
$pAy the sErro
Samy ($Stsatus, $, EpAy the asswyle = $ACGetCuuesmerAy the     retBry_W{Ay the ID},wyle = $ACGetsub (<",wn t

        if ($Siel, 2)###
R mem    S)

        }
    r"");;
        ng
    }
@AddrtusId\@Fi#s $slit(/,/, $EpAy the {Addrtus\@Fi}nst,  ;
$AddrtusIDst,  ;
%Addrtus\@Fist,  esse tha$AddrtusID (@AddrtusId\@Fi)
            S)
        {
Samy ($Stsatus, $, EAddrtus\@Fi{$AddrtusID}asswyle = $ACGetCuuesmerAddrtus(    etBry_W{Ay the ID},w$AddrtusID, yle = $ACGetsub (<",wn tr

        if ($Siel, 2)###
R mem    re
                    {
        $AC

    {
CuuesmerAddrtusISSEx(", 0,TbuisuuesmeriSea<xme tleft nlesslenamulti    to awritsESso                 nmet!up thripSho
        }
    r"");;
        );
            }##g
    }
@Tempsswkeys %Addrtus\@Fist,

#Tempss= -1SUCCE    S)
            {
        $AC

    {
CuuesmerAddrtusISSEx(",                T    #isuuesmeriSea<xme tleft nlesslenamulti    to awritsESso                 nmet!up thripSho
        }
    r"");;
        ng
")
;

sType,$sSelect,$nRtil,$sCcecked);})
;
(     Pidden paHash->{TYP:}i=~ /^INVOICE/ )last;                se        Invoice fddrtusfitrch?
            sType  ss 'VhyidAsInvoiceAddrtus';        se                                            T    sum                 eedtestedeessae thafddrtusfitrc;
(     pAy the ->{InvoiceAddrtusRtil}Wn= 1 )last;                s        T    #iCuuesmerirtil overrid thary_Wirtil mem    re
                    nRtilny 0th2(
            sSelectV=     pAy the ->{InvoiceAddrtus}F                               # De our  (0 -FIx r)efddrtusfitrc    {
Samy ($Stsatus, $, EAddrtus\@Fi{$sSelect}asswyle = $ACGetCuuesmerAddrtus(    etBry_W{Ay the ID},w$sSelect, yle = $ACGetsub (<",wn trr

        if ($Siel, 2)###
Re mem    rre
                        {
        $AC

    {
CuuesmerAddrtusISSEx(", 0,TbuisuuesmeriSea<xme tleft nlesslenamulti    to awritsESso                 nmet!up thripSho
        }
    r"");;
        ));
            );
                    }} mem    re
                    nRtiln V=     pBry_W->{InvoiceAddrtusRtil};lse                                    Addrtusfrtil essage thatal mem            sSelectV=     pBry_W->{InvoiceAddrtusID};                              # De our  (0 -FIx r)efddrtusfitrc    }##    tt}##
            }
(     Pidden paHash->{TYP:}i=~ /^DELIVERY/ )last;                s        Deli loy  ddrtusfitmch?
            sType  ss 'VhyidAsDeli loyAddrtus';        se                                        T    sum                 eedtestedeessae thafddrtusfitrc    nRtiln V=     pBry_W->{Deli loyAddrtusRtil};lse                                    Addrtusfrtil essage thatal mem        sSelectV=     pBry_W->{Deli loyAddrtusID};e
        # De our  (0 -FIx r)efddrtusfitrc}})
;
(     Pidden paHash->{TYP:}i=~ /FORM$/ )last;                se            Addrtusfstrifitmch?
        ;
(     nRtiln!BS2 )last;                se                                # O surshewn essaRtiln2 mem    re
                    $sInsid T
         Bn""efitrc    }##    tt    {
        $AC

    {
CuuesmerAddrtusISSEx(",                T    #isuuesmeriSea<xme tleft nlesslenamulti    to awritsESso                 nmet!up thripSho
        }
    ""efitrcng
")
    {
        $AC

    {
CuuesmerAddrtusISSEx(",                T    #isuuesmeriSea<xme tleft nlesslenamulti    to awritsESso                 nmet!up thripS__)
        {
        Ftring 'm        #  amelaeas'.fitm#iT filut tlnDeu"Inddrtusfstriaasds < $#on     nRtil,         # ifmsworeedk liessae thartil mem###        }
$sTafilFtring  n    =         elf->{Vh t file}->{ADDR#
_TABLE};##        }
$sT tln             =         elf->{Vh t file}->{'ADDR#
_TITLE'#. $nRtil};##        }
$sT tln_1            =         elf->{Vh t file}->{'ADDR#
_TITLE1'#. $nRtil};##        }
$sFtri                = '<TD>' .C$    elf->{Vh t file}->{'ADDR#
_FORM'#. $nRtil}#. '</TD>';de
        {
        Nurns:    w mcolumnsre surmd thes!!        ioact ur s-in!ssse oh    nmk lirow    {
        O                wi@Reacter sos ddrtuses                  expanotaoile latocatabil mem###        }
$nColumnsr#s
#  ss         elf->{Vh t file}->{ADDR#
_COLUMNS} ||    1;            #aNurns:    w mcolumnsr-    de our   o 1####        ;
( !$sFtrinin !$sTafilFtring )  mem    S ##    tt
        }
    ""efitrcn lse                                    Noustriaasr-            #caemeterohe ao##
    ##        }
$syddrtusT
         Bn""efitr})
;
(     nRtilny= 0 )last;                    se                                # Rtiln0a- sixed  ddrtusfitmch?
            syddrtusT
         .= '<TR><TD>';        se                                            # JsworaesionLE cell##    t        syddrtusT
         .= smRL =f($sFtri,de Name





w$sSelect,    last;                se            AddrtusfID##tName





w$Addrtus\@Fi{$sSelect}->{N$sF},        se            Addrtusfr
            fehi #s##tName





w$Addrtus\@Fi{$sSelect}->{Lss 1},##tName





w$Addrtus\@Fi{$sSelect}->{Lss 2},##tName





w$Addrtus\@Fi{$sSelect}->{Lss 3},##tName





w$Addrtus\@Fi{$sSelect}->{Lss 4},##tName





w$Addrtus\@Fi{$sSelect}->{PostCode},##tName





w    {
        $ACGetCthe ryN$sF(
Addrtus\@Fi{$sSelect}->{Cthe ryCode}));?
            syddrtusT
         .= '</TD></TR>';##    tt}##
            }e    else                                    se                                # Rtiln1 #    s    lectVactertionUC        m{
    else                                                                # Rtiln2 #    s    lectV0 -FIlhwftrifitmc$sT tln = smRL =f($sT tln,yle = $ACGetshr    0 (-1, 302));                se        Ins No t tlnDacterhctepts?
        ;
(     nRtiln=BS2 )last;                se                                # Ins No t
            ferInddrtusfstri mem    re
                ;
(     Pidden paHash->{TYP:}i=~ /^INVOICE/ ) mem    rre
                    $sT tln_1 = smRL =f($sT tln_1,yle = $ACGetshr    0 (-1, 303,yle = $ACGetshr    0 (-1, 304)));;
        ));
            )        }} mem    rre
                    $sT tln_1 = smRL =f($sT tln_1,yle = $ACGetshr    0 (-1, 303,yle = $ACGetshr    0 (-1, 305)));;
        ));
            )})
        }
$nCthe i= 0th2(
    }
$nRowCthe i= 0th2(
    }
$sCcth2(
    esse tha(keys %Addrtus\@Fi) mem    re
                ;
(     Addrtus\@Fi{$_}->{$sType} ) mem    rre
                    ;
(     nCthe i%
$nColumnsry= 0 )##tName
e
                            syddrtusT
         .= '<TR>';        se                                            Newirow    {
        ));
            )    ;
(     _ eq
$sS    lectVanot    nRtiln=BS1 )last;                s        FssaRtiln1 cceck    de our  fddrtusfitrc    e
e
                            sCh#=    ' CHECKED';    {
        ));
            )            }} mem    rr
e
                            sCh#=    '';    {
        ));

                    $syddrtusT
         .= smRL =f($sFtri,de Name







w    {
        $ACGetshr    0 (-1, 301),de Name







w$_,    last;                se            AddrtusfID (essaRADIOacteton)de Name







w$sCh,        se                                # Oe bstahw'CHECKED'de Name







w$Addrtus\@Fi{$_}->{N$sF},        se            Addrtusfr
            fehi #s##tName







w$Addrtus\@Fi{$_}->{Lss 1},##tName







w$Addrtus\@Fi{$_}->{Lss 2},##tName







w$Addrtus\@Fi{$_}->{Lss 3},##tName







w$Addrtus\@Fi{$_}->{Lss 4},##tName







w$Addrtus\@Fi{$_}->{PostCode},##tName







w    {
        $ACGetCthe ryN$sF(
Addrtus\@Fi{$_}->{Cthe ryCode}));?
            e mem    rr    nCthe ++;last;                se                                # Cthe icells
                    ;
(     nCthe i%
$nColumnsry= 0 )        se                                # Fuoterow    {
        ))e
                            syddrtusT
         .= '</TR>';        se

    {
erow    {
        ))$nRowCthe ++;last;                se                        # Cthe ir #s##tName
};
        ));
            )})

            mTRle(     nCthe i%
$nColumnsr!= 0 )last;                    se

    {
etabilir #ree
metec
    {
d mem    re
                ;
(     nRowCthe i> 0#) {
$syddrtusT
         .= '<TD> </TD>' }                        If!ssse oh    nmk lirowt:    fdd :mptyicells
                    nCthe ++;
                ;
(     nCthe i%
$nColumnsry= 0 )##tName{
                    $syddrtusT
         .= '</TR>';##    tt        laFist,      ));
            )})
        );
    EsyddrtusT
         B~ s/<br>[,\s]*/<br>/gi;        se                                            Rimove              tole ammas;
    EsyddrtusT
         B~ s/[,\s]*<br>/<br>/gi;        se                                            Rimove tr\"ltole ammas;

        }
    smRL =f($sTafilFtring,##tName

$sT tln,##tName

$    tu
    pSetup
{FORM_EMPHASI
_COLOR},                                     Bo sam##tName

$    tu
    pSetup
{FORM_BACKGROUND_COLOR},                                     Backgre no memS                $syddrtusT
        ,##tName

$sT tln_1ns##    t}h2
        }
    ""efit})

f)

###########################################################
###
VarTagH filerd-  whibick'f0 tth t file t# #Se s-th t file t# #Te# ifshouldneedAR:UVanotVALUEchidden pas t#          elf->{Vh t file}->{n$sF}$ th#etpao  field #tusageeAvalid asn:     sTag -wtagded fUC# aaaaaaaaaaaa$sInsid T
         -wList - referer
            betwee# if thdanot< $,UC# aaaaaaaaaaaa$Pidden paHash#-ehase w mhidden pas,UC# aaaaaaaaaaaa$sIri-rcur - ottagdpresix,UC# aaaaaaaaaaaa$sFuotTag -wfuoter
            w mcur - ottag;UC#tu
#
# aaa: :mptyiif the###sageeRysze stZyb No  Dec  7 20:58:25 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd (1999)#####

#####################################################as#####
VarTagH filerurePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sId, $sFuotTagassword)     }
;
(     sTag !~ /^\// )loCmr})
$    elf->{Vh t file}->{    Pidden paHash->{AR:U}}$nC$Pidden paHash->{VALUE}s##    t}h2
        }
    ""efit})


###########################################################
###
De our TagH filerd-  whibick'f0 tankmewn oags###
Lesnsmup tth tagd!        lhluB2B    XML    TageDhaseloOtuIf!se notldLi\w' is tth tagdby inUCr a(meanthe shluwhol -<                    # :    sTag....>h#equ- re)sageeIftmetemodun'ta-            l she loyth soshe ouccedd #tusageeAvalid asn:     sTag -wtagded fUC# aaaaaaaaaaaa$sInsid T
         -wList - referer
            betwee# if thdanot< $,UC# aaaaaaaaaaaa$Pidden paHash#-ehase w mhidden pas,UC# aaaaaaaaaaaa$sIri-rcur - ottagdpresix,UC# aaaaaaaaaaaa$sFuotTag -wfuoter
            w mcur - ottag;UC#tu
#
# aaa: Li\w' im< asFenage foagngesageeRysze stZyb No  Dec  7 20:58:25 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd (1999)#####

#####################################################as#####
De our TagH filerurePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sId, $sFuotTagassword) = @_$sXMLTagd= tyle = $ACB2B->GetXML($sTag);})
        }
    rSERis r(    sXMLTag)) ?i$sXMLTagd: $sFuotTag;    iteef)f)

##############################################################
###
Rse\"lPricFT
        TagH filerd-  whibick'f0 trse\"l    ly tchOtuSe s-XML    th t fil###
B2B->{XML}->{oag}$ th#etpao  fielal lly t!betwee# oagsde#tusageeAvalid asn:     sTag -wtagded fUC# aaaaaaaaaaaa$sInsid T
         -wList - referer
            betwee# if thdanot< $,UC# aaaaaaaaaaaa$Pidden paHash#-ehase w mhidden pas,UC# aaaaaaaaaaaa$sIri-rcur - ottagdpresix,UC# aaaaaaaaaaaa$sFuotTag -wfuoter
            w mcur - ottag;UC#tu
#
# aaa: :mptyiif the###sag##

#####################################################as#######
Rse\"lPricFT
        TagH filerurePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sId, $sFuotTagassword)     }
;
(     sTag !~ /^\// )se                                            Ignsset< $-tag    iampletely

--)
        {ref({sInsid T
        ))                                            I                # if thr
            ;
sse et!!n-XML    th t fil##tmch?
                {
        $ACB2B->SetXML($sTag,n${sInsid T
        );?
            $sInsid T
         Bn""ee                                        T
         meteneededderyssse
            ng
            }
        }
 ""ee                                                            BofielageDels_)removeoiteef)f)

###########################################################
De our RimovtheTagH filerd-  whibick'f0 tankmewn oags###
As
De our TagH filerdexcepthe aoaankmewn oagsctre removeoiti atoge        # drifieaoter
            betwee# oagsde####
Lesnsmup tth tagd!        lhluB2B    XML    TageDhaseloOtuIf!se notldLi\w' is tth tagdby inUCr a(meanthe shluwhol -<                    # :    sTag....>h#equ- re)sageeIftmeteremoveshe loyth so###
###
Avalid asn:     sTag -wtagded fUC# aaaaaaaaaaaaa$sInsid T
         -wList - referer
            betwee# if thdanot< $,UC# aaaaaaaaaaaaa$Pidden paHash#-ehase w mhidden pas,UC# aaaaaaaaaaaaa$sIri-rcur - ottagdpresix,UC# aaaaaaaaaaaaa$sFuotTag -wfuoter
            w mcur - ottag;UC#tu
#
# aaa: Li\w' im< asFenage foagngesageeRysze stZyb No  Dec  7 20:58:25 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd (1999)#####

#####################################################as#####
De our RimovtheTagH filerurePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sId, $sFuotTagassword) =) = @_$sXMLTagd= tyle = $ACB2B->GetXML($sTag);})
;
( SERis r(    sXMLTag)#)s#eD n'ta ouccer
        ,dLit
# Li\w' im< astagloCmr})

        }
    $eXMLTag;d va        }
        }
    else        e

            #bofiel
            ttintagloCmr})
        {    ref({sInsid T
        )#) {
$$sInsid T
         Bn""e );

        }
    ""efitr}iteef)f)

###########################################################
IgnsseTagH filerUC#tu
move t
         rifi!        lhlutagdanotge foagngesageeRysze stZyb No  Jul 25 22:30:51 BST 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
IgnsseTagH filerUCePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sId, $sFuotTagassword) =        {    ref({sInsid T
        )#) {
$$sInsid T
         Bn""e );

        }
    ""efit})



###########################################################
NetInB2BTagH filersageeIftloc if thi ergioners iatalhremoveshge foagsm< $fo
            betwee#UC# aaaAvalid asn:     sTag -wtagded fUC# aaaaaaaaaaaaaaa$sInsid T
         -wList - referer
            betwee# if thdanot< $,UC# aaaaaaaaaaaaaaa$Pidden paHash#-ehase w mhidden pas,UC# aaaaaaaaaaaaaaa$sIri-rcur - ottagdpresix,UC# aaaaaaaaaaaaaaa$sFuotTag -wfuoter
            w mcur - ottag;UC#tutu
#
# aaa: ""ngesageeRysze stZyb No  Jul 28 14:20:06 BST 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
NetInB2BTagH filersaePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sId, $sFuotTagassword) =) =;
(     sTag !~ /^\// )last;                se
        I        notpEtintagloCmr})
 @_$sDigess BStyle = $ACB2B->Get('wordDigess'ath2
;
( $sDigess )                    I                # if thaiatalhremove oagsctnd-ly tchem    h?
        ;
( ref({sInsid T
        )#) {
$$sInsid T
         Bn""e );
        ng
            }
        }
 ""efit})



###########################################################
UnregTagH filerd-  whibick'f0 tUNREGfoagnge aIftloc if thi ergioners iatalhremoveshge foagsm< $fo
            betwee#UC# aO                wi@Reproduceseaewl    nthe p($s    tnd-be n is toaoegin p($smessageeAvalid asn:     sTag -wtagded fUC# aaaaaaaaaaaaa$sInsid T
         -wList - referer
            betwee# if thdanot< $,UC# aaaaaaaaaaaaa$Pidden paHash#-ehase w mhidden pas,UC# aaaaaaaaaaaaa$sIri-rcur - ottagdpresix,UC# aaaaaaaaaaaaa$sFuotTag -wfuoter
            w mcur - ottag;UC#tu
#
# aaa: Li\w' im< asFenage foagngesageeRysze stZyb No  May 16 15:23:37 BST 2000messageeCopyright (c)                        # ASoftwl        #Ltd (1999)#####

#####################################################as#####
UnregTagH filerurePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sId, $sFuotTagassword) = @_$sDigess BStyle = $ACB2B->Get('wordDigess'ath2=) =;
(     sTag !~ /^\// )last;                se
        I        notpEtintagloCmr})
;
( $sDigess )                    I                # if thaiatalhremove oagsctnd-ly tchem    h?
        ;
( ref({sInsid T
        )#) {
$$sInsid T
         Bn""e );

        }
    ""efitrcng
)            }} mem    {
            #)
        # T    sum                 e surhll wefstctree
JavaSn ourei-lSis fil$.h2

        O                wi@Re        # if thaiJavaSn ourealethdanotge thsn ourei-lnoT    whiedsa                    Soi-rentge th     0 -wRejsworshewewl    nthe anotjup bick' $forigitahwhigeacc        #)
        }
$sRrst -r#=    w    {
        $ACGetRrst  -r();    else##Cur - othigeacc        $sRrst -r#=~ s"/[^/]*$"/";e                                            Rimove fiilued fUC            puse @tu
    Pige\@Fi,
$sRrst -r;e                                    Sfsse eea<xmhigeacc        puse @tu
    Pige\@Fi,
$sRrst -r;e                                    Sfsse eea<xmhige (twire)sa)
        }
{
Samy ($Stsermin$StsHTML_sswyle = $AC
#
#ToLastPige(7," " , ng Name
















w    {
        $ACGetshr    0 (-1, 208),de Name
















\@tu
    Pige\@Fi,
$tu
    sWebSiteUrl,de Name
















$tu
    sClnh isUrl,     tu
    pSetup
, %tu
    InputHash",wn tr

        if ($Siel, 2)###
R                I        eventge thdidn'taworkr-            #givewup -e        # if thans:  0  sem    re
                    {
        $ACReportermin(tsermin$Syle = $ACGetsub (<",wn trr}h2=) =                {
        $ACAss NoIs                v"ssw$::TRUE;else##Chrwtr    # ifs_)i            esureen aoaPRL =Pigeemodun'ta whiuXML    m
#0 r t                {
        $ACPRL =Pige(tsHTML, ASSER,w$::TRUE);            PRL =wwl    nthe p($s    tnd-exitchem    exitd)     }#

        }
    $eFuotTag;;
        ng
            }
        }
 ""efit})



##############################################################
PricFTagH fileru-epricFdoag  whibickmessageeAvalid asn:     sTag -wtagded fUC# aaaaaaaaaaaaa$sInsid T
         -wList - referer
            betwee# if thdanot< $,UC# aaaaaaaaaaaaa$Pidden paHash#-ehase w mhidden pas,UC# aaaaaaaaaaaaa$sIri-rcur - ottagdpresix,UC# aaaaaaaaaaaaa$sFuotTag -wfuoter
            w mcur - ottag;UC#tu
#
# aaa: noth soscterLi\w' is $sInsid T
         by  etabiliw mhricFsngesageeRysze stZyb No  Dec  7 21:06:24 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd (1999)###mes##

#####################################################as#####
PricFTagH filerurePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sId, $sFuotTagassword) ==) =;
(     sTag !~ /^\// )last;                se
        I        notpEtintagloCmr})
;
( $    elf->{Cur - oSectper
} )last;                se                            I        sectper b
h#etd va    {)
        }
@Respons(site        #)
        # Weeneedage foaxiinutrings fa $f whculaeaage fhricFsnge        #)
        ;
(!$                    # O sam::bTaxDataP
#0 d) mem    re
                #
                # "rw"age foaxib

                #
                @Respons(sswyle = $AC
adTaxSetupFRle(yle = $ACGetsub (<",wn trr

Respons([0]$Siel, 2)###
R mem    re{

        }
    r@Respons();;
        ));
            )                    # O sam::P
#0 Adva redTax();;
        );
            $    elf->P
#0 (${sInsid T
        );?

            @Respons(sswyle = $ACGetsroduct($Pidden paHash->{PROD_REF},w$    elf->{Cur - oSectper
},de Name








 Syle = $ACGetsub (<",se                            g    tege thproduc        wbject)
        }
{
Samy ($Status, $, EpsroductasswoRespons(site

        if ($Siel, 2)###
R ng NamS ##    tt
        }
    ""efitrc    }t;                se                            I        ed bprobilm,sFengetpit
h2(

;
    rSERis r $Epsroduct{PRICES}) mem    re
                #
                # Ne ris_)kmewree
ge thproduc        hasead bth t nts?
            #
                }
{
Vh t nt\@Fi,
$sLss );
                ;
(     psroduct->{COMPONENTS} ) mem    rre
                    {
Vh t nt\@Fi,
$sLss )sswyle = $ACGetVh t nt\@Fi($Pidden paHash->{PROD_REF});;
        ));
            )#
                # Ne ris_)workr ErrmTRACEhricFsis_);how    {
        #
                }
{
bShowRse\"lPricF($StbShowCuuesmerPricF($StnAy the Sccedul )sswyle = $ACDn pamss PricF(ToShow();;
        )
                }
$sPricFLabelT
        ss     yle = $ACB2B->GetXML('RETAIL_PRICE_TEXT');
                ;
(
bShowRse\"lPricF( &&StbShowCuuesmerPricF() mem    rre
                    }
$sPricFLabelsswyle = $ACGetshr    0 (-1, 294,
$sPricFLabelT
        );;
        ))#;
        ))# Showrdtheernernarse\"l    pricF;
        ))#;
        ))@Respons(sswy                # O sam::FtringSccedul PricF((    psroduct, ng Name
1, \
Vh t nt\@Fi,
$sPricFLabel, 1);e                                    Showrd wiree\"l    pricF;
        ))$$sInsid T
         Bn
Respons([2];?
            e mem    rr    sPricFLabelsswyle = $ACGetshr    0 (-1, 293,
$sPricFLabelT
        );;
        ))@Respons(sswy                # O sam::FtringSccedul PricF((    psroduct, ng Name
tnAy the Sccedul , \
Vh t nt\@Fi,
$sPricFLabel);                    Showrd widtheernpricF;
        ))$$sInsid T
         .Bn
Respons([2];?
            e;
            )        };
(
bShowCuuesmerPricF() mem    rre
                    #;
        ))# Showre surdtheernpricF;
        ))#
                    ;
 (0ry= s whar(@{    psroduct->{'PRICES'}->{    nAy the Sccedul }}))##tName
e
                        #
                        #    T    #iproduc         thanavailabili;
 atal'sepricFdsccedul !! Tnotpincluded
                        #
                        $$sInsid T
         Bn    {
        $ACGetshr    0 (-1, 351);            'Te thproduc         th ur - osuranavailabil'    {
        ));
            )            }}            se                            atal'sepricFdsccedul !!ncluded
                        e
                        @Respons(sswy                # O sam::FtringSccedul PricF((    psroduct, ng Name

tnAy the Sccedul , \
Vh t nt\@Fi,
$yle = $ACB2B->GetXML('RETAIL_PRICE_TEXT'));;
        )))$$sInsid T
         Bn
Respons([2];?
            e
};
        ));
            )        }} mem    rre
                    #;
        ))# Showre surrse\"l    pricF;
        ))#;
        ));
 (0ry= s whar(@{    psroduct->{'PRICES'}->{    y                # O sam::RETAILID}}))##tName
e
                        #
                        #    T    #iproduc         thanavailabili;
 d wiree\"l    pricF!! Tnotpincluded
                        #
                        $$sInsid T
         Bn    {
        $ACGetshr    0 (-1, 351);            'Te thproduc         th ur - osuranavailabil'    {
        ));
            )            }}
                        e
                        @Respons(sswy                # O sam::FtringSccedul PricF((    psroduct, ng Name

1, \
Vh t nt\@Fi,

$yle = $ACB2B->GetXML('RETAIL_PRICE_TEXT'));;
        )))$$sInsid T
         Bn
Respons([2];?
            e
};
        ));
            )}
            ng
            }
        }
 ""ee                                                    ast;                se            Alwayshremove oagfit})



###########################################################
###
SectperTagH filer #    s    ctper eag  whibickmessageeNote:-<                    # :SE{
ON BLOB="b
hfiilued f"/> actthg
poteUC# aaaaaaa$    elf->{Cur - oSectper
}  th#etp    # if    rnakeptmessageeAvalid asn:     sTag -wtagded fUC# aaaaaaaaaaaaa$sInsid T
         -wList - referer
            betwee# if thdanot< $,UC# aaaaaaaaaaaaa$Pidden paHash#-ehase w mhidden pas,UC# aaaaaaaaaaaaa$sIri-rcur - ottagdpresix,UC# aaaaaaaaaaaaa$sFuotTag -wfuoter
            w mcur - ottag;UC#tu
#
# aaa: noth soscterse s-$    elf->{Cur - oSectper
} ao  fielal lhidden parBLOBngesageeRysze stZyb No  Dec  20 21:06:24 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd (1999)#####

#####################################################as#####
SectperTagH filerurePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sIdassword) =) =;
(     sTag !~ /^\// )last;                se                    I        notpEtintagloCmr})
$    elf->{Cur - oSectper
} nC$Pidden paHash->{BLOB}s##    t}h2
        }
    ""e                        ast;                se            Alwayshremove oagfit})



###########################################################
###
M\" Fc$sFTagH filer###
Li\w' i SRCuhidden par!n    awFRAMEfoagnge ange aIftMAINFRAME-XML    th t filai-lSERis rianotSRC=ed f isafe nonge a!n    insid er
        ,ded f                  eedLi\w' id by d wi fielal lMAINFRAME-XMLnge ath t fil.loOtusagee
aAvalid asn:     sTag -wtagded fUC# aaaaaaaaaaaaaaa$sInsid T
         -wList - referer
            betwee# if thdanot< $,UC# aaaaaaaaaaaaaaa$Pidden paHash#-ehase w mhidden pas,UC# aaaaaaaaaaaaaaa$sIri-rcur - ottagdpresix,UC# aaaaaaaaaaaaaaa$sFuotTag -wfuoter
            w mcur - ottag;UC#tutu
#
# aaa: noth soscterile tiis $$sInsid T
        ngesageeRysze stZyb No  Jul 18 11:26:08 BST 2000messageeCopyright (c)                        # ASoftwl        #Ltd (2000)#####

#####################################################as#####
M\" Fc$sFTagH filer##ePath
    {Self#s $nam =unt}
($sTag,na$sInsid T
        ,
$Pidden paHash,n$sIdassword) =) =;
(     sTag !~ /^\// )last;                se                    I        notpEtintagloCmr})
 @_$sXMLTagth2
;
( $tu
    InputHash{MAINFRAMEURL} ) mem    h?
            sXMLTagd= ttu
    InputHash{MAINFRAMEURL}efitrcng
)            }} mem    {
            $sXMLTagd= tyle = $ACB2B->GetXML("MAINFRAMEURL");;
        ng
    ;
( SERis r(    sXMLTag)#)sse                                            Ri\w' i SRCuhidden parby dagd field va    {)
        ;
( ref({sInsid T
        )#) mem    re
                ;
(     sXMLTagd!~ /^((http:)|(\/))/ ) mem    rre
                    ;
(     sXMLTagdeq 'lc$sFset.html' )##tName
e
                            sXMLTagd= 'catalogbody.html'?
            e
};
        ))    sXMLTagd= ttu
    sAy the Sc oure. '?'#. 'PRODUCTPAGE='#. $sXMLTagth2
    e
};
        )$$sInsid T
         B~ s/(\s+SRC\s*=\s*)((\"[^\"]+\")|([^\ \>]+))((\s+)|(\>+))/$1\"$sXMLTag\"$5/is;
            )}
            ng
            }
        }
 ""ee                                                    ast        Alwayshremove oagfit})


###########################################################
FtringPricF -wftring sionLE pricF;
Otusagee
Avalid as:     $PricF -wpricFdoolSis\w'y    }#



sPricFMsg -wpricFdhcteptsageeame

$sTax -wtaxiinutsageeame

$sIncTax -wincludthe saxiinutsageeame

$bTaxExlu pveO sur-lSis\w'y saxiexclu pvere susageeame

$bTaxInclu pveO sur-lSis\w'y saxiinclu pvere susagee

#
# Reftringa-dllricF!!nutsagsageeRysze stZyb No  Dec 29 23:07:05 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd (1999)#####

#####################################################as#####
FtringPricF##ePath
    {Self#s $nam =unt}
($PricF,$sPricFMsg,$sTax,$sIncTax,$bTaxExlu pveO su,$bTaxInclu pveO suassword) = @_($sPricF,$sEPricF,$fPricF,$sPricFexl,$sPricFincl);?

    }
$sCur - cyeeam= ttu
    pCatalog
->{SCURRENCY}d) = @_$sEFtring  n    m= ttu
    pSetup
->{EURO_FORMAT}d) = @_$sECur - cyeam= ttu
    pCatalog
->{EUR}->{SCURRENCY}d) = @_$fEuroConv N perm= ttu
    pCatalog
->{EUR}->{EXCH_RATE}d) = @_$sPFtring            = '%s%.2f'd)     }
;
(     bTaxExlu pveO sur)last;                    se                                # Exlu pvere susaCmr})
$fPricF nC$PricF/100.0;last;                se                                # PricF!!n "rwlrilneusaCm}        e me        }e    else                                    se                                        # Inclu pvere    #bofisaCmr})
$fPricF nC(1.0 + ttu
    pSetup
->{TAX_1_RATE}/10000.0) *C$PricF/100.0;las        Add saxg
            }
;
( !$bTaxInclu pveO suranot!    bTaxExlu pveO sur)last;                    s# Dis\w'y exclu pveranotinclu pverhricFsnge    r})
$sPricFexl  = smRL =f($sPFtring,$sCur - cy,$PricF/100.0);e                                    Ftring exlu pverhricF})
$sPricFincl = smRL =f($sPFtring,$sCur - cy,$fPricF);last;                s        Fssing inclu pverhricFh2
;
( $tu
    pSetup
->{EURO_PRICES}r)last;                    se            # EuroEhricFsiee
meeded mem    {
            $sEPricF#  ss $mRL =f($sPFtring,$sECur - cy,$PricF/$fEuroConv N per/100.0);e# C lculaeaaEuroEexclu pverpricF;
        $sPricFexl  = smRL =f($sEFtring,$sPricFexl,$sEPricF);last;                        Ftring exclu pverpricFiif the##            $sEPricF#  ss $mRL =f($sPFtring,$sECur - cy,$fPricF/$fEuroConv N per);                    C lculaeaaEuroEinclu pverhricFh2
$sPricFincl = smRL =f($sEFtring,$sPricFincl,$sEPricF);last;                    Fssing inclu pverhricFiif the##            );

        }
        {
        $ACGetshr    0 (-1,227,$sPricFMsg,$sPricFexl,$sPricFincl,$sIncTaxns##    t}h2h2(    sPricF nCsmRL =f($sPFtring,$sCur - cy,$fPricF);last;                s                Fssing hricFh2    ;
( $tu
    pSetup
->{EURO_PRICES}r)last;                    se            s        Add EuroEhricFiee
meeded memr})
$sEPricF nCsmRL =f($sPFtring,$sECur - cy,$fPricF/$fEuroConv N per);                            C lculaeaaEuroEhricF})
$sPricF  = smRL =f($sEFtring,$sPricF,$sEPricF);last;                s                Fssing iampleteuhricFiif the##                }
        }
     {
        $ACGetshr    0 (-1,225,$sPricFMsg,$sPricF,$sTax);fit})


###########################################################
FtringPricFRowt:    fssing hricFerow    {Otusagee
Avalid as:     $PricF -wpricFdoolSis\w'y    }#eeame

$sIncTax -wincludthe saxiinutsag                            sQlimi     -wquantityiinutsageeame

$bTaxExlu pveO sur-lSis\w'y saxiexclu pvere susageeame

$bTaxInclu pveO sur-lSis\w'y saxiinclu pvere susagee

#
# Reftringa-dllricF!!nutsagsageeRysze stZyb No  Dec 29 23:07:05 GMT 1999messageeCopyright (c)                        # ASoftwl        #Ltd (1999)#####

#####################################################as#####
FtringPricFRow    {
Path
    {Self#s $nam =unt}
($PricF,$sIncTax,$sQlimi    ,$bTaxExlu pveO su,$bTaxInclu pveO suassword) = @_($sPricF,$sEPricF,$fPricF,$sPricFexl,$sPricFincl);?

    }
$sCur - cyeeam= ttu
    pCatalog
->{SCURRENCY}d) = @_$sEFtring  n    m= ttu
    pSetup
->{EURO_FORMAT}d) = @_$sECur - cyeam= ttu
    pCatalog
->{EUR}->{SCURRENCY}d) = @_$fEuroConv N perm= ttu
    pCatalog
->{EUR}->{EXCH_RATE}d) = @_$sPFtring            = '%s%.2f'd)     }
;
(     bTaxExlu pveO sur)last;                    se                                    # Exclu pvere susaCmr})
$fPricF nC$PricF/100.0;last;                se                                    # PricF!!n "rwlrilneusaCm}     me        }e    else                                    se                                            # Inclu pvere    #bofisaCmr})
$fPricF nC(1.0 + ttu
    pSetup
->{TAX_1_RATE}/10000.0) *C$PricF/100.0;lass        Add saxg
            }    }
;
( !$bTaxInclu pveO suranot!    bTaxExlu pveO sur)last;                    ss# Dis\w'y exclu pveranotinclu pverhricFsnge    r})
$sPricFexl  = smRL =f($sPFtring,$sCur - cy,$PricF/100.0);e                                    Ftring exclu pve})
$sPricFincl = smRL =f($sPFtring,$sCur - cy,$fPricF);last;                s        Fssing inclu pveh2
;
( $tu
    pSetup
->{EURO_PRICES}r)last;                    se            # Add EuroEhricFiee
meeded mem    {
            $sEPricF#  ss $mRL =f($sPFtring,$sECur - cy,$PricF/$fEuroConv N per/100.0);e# Exclu pve})
    $sPricFexl  = smRL =f($sEFtring,$sPricFexl,$sEPricF);##            $sEPricF#  ss $mRL =f($sPFtring,$sECur - cy,$fPricF/$fEuroConv N per);                    Inclu pve})
    $sPricFincl = smRL =f($sEFtring,$sPricFincl,$sEPricF);fitrc}})
;
(         elf->{Vh t file}->{FORMAT_PRICE_ROW_BOTH} )se                                            I                # if thaith t fil,xatasit mem    S)

        }
    smRL =f($    elf->{Vh t file}->{FORMAT_PRICE_ROW_BOTH},$sPricFexl,$sPricFincl,$sIncTax,$sQlimi    );fitrc}    ##
            }e    else                                    se
        O                wi@ReusFdhctept 228 mem    S)

        }
        {
        $ACGetshr    0 (-1,228,$sPricFexl,$sPricFincl,$sIncTax,$sQlimi    );fitrc}##    t}h2h2(    sPricF nCsmRL =f($sPFtring,$sCur - cy,$fPricF);last;                s                Dis\w'y ei        # dexclu pverer inclu pveh2    ;
( $tu
    pSetup
->{EURO_PRICES}r)last;                    se            s        Add EuroEhricFsiee
meeded memr})
$sEPricF nCsmRL =f($sPFtring,$sECur - cy,$fPricF/$fEuroConv N per);})
$sPricF  = smRL =f($sEFtring,$sPricF,$sEPricF);g
            }
;
( $    elf->{Vh t file}->{FORMAT_PRICE_ROW} )last;                se                    I                # if thaith t fil,xatasit mem{;

        }
    smRL =f($    elf->{Vh t file}->{FORMAT_PRICE_ROW},$sPricF,$sQlimi    );fitr} me        }e    else                                    se                                            # O                wi@ReusFdhctept 224 mem{;

        }
        {
        $ACGetshr    0 (-1,224,$sPricF,$sQlimi    );fitr} me})



#################################################################
ick($s    SimpleLockr-    port filafiilulockthe moduil###sageWriga-nrby Zoltan Bodi###sageCopyright (c)                        # ASoftwl        #Ltd 2000messag

#############################################################sageUs, $:messag= @_$rLckr=
 - tSimpleLock('../atals.das'ath2#    }
$nRe     Bn
rLck->Lock(",se                            trydoolg    tegelulockh2#

nRe     Bs         impleLock, 2)###
R m#em{;
#                ataegelulockedeeiiluthripS#tr} m#)        };

nRe     Bs         impleLock, ERR_TIMEOUTR m#em{;
#                a time Errhaseoccureoititr} m#)        };

nRe     Bs         impleLock, ERR_DIRPERM
R m#em{;
#                eiiluppamss per probilmsititr} m#)        };

nRe     Bs         impleLock, FAILURER m#e
rLck->Unlock(",se                                # "rleataegelulock m#e(Noteen aoagelulockf thautoings whiy "rleata$#on geluwbject'-lSEif uctper.R m#e m#e m#as##
ick($s        impleLock;;
rCe!v
#0 qw($2)###
 $ERR_TIMEOUT $ERR_DIRPERM
 $ERR_OPNANDLCK $ERR_NOOPNNOLCK;
        )$ERR_MORELCK $ERR_STALELCK $ERR_RECURSE $FAILURE_$s_sHosted f);;
        )
$2)###
 = 0th2$FAILURE_= -1th2$ERR_TIMEOUT _= 1,se                                # time Errwair sosferInulock m$ERR_DIRPERM
 = 2,se                                # insuffici- ot(directoruasppamss pers m$ERR_OPNANDLCK = 3,se                                # insanFiifate:-bofie.OPNranot.LCK presd a##$ERR_NOOPNNOLCK = 4,se                                # insanFiifate:-nk lio
 d wiabove l        #presd a##$ERR_MORELCK = 5;e
        # insanFiifate:-ssse .LCK eiils m$ERR_STALELCK = 6,se                                # ifailulockeiiludetecteoit$ERR_RECURSE = 7;e
        # recuN per detecteoitit$s_sHosted f#=    '';
        # hosted f# th#fssedp    # ifo ref
        rieveoitit#

#################################################################     impleLock,  - t-ulockfwbject
alur     uctor. Noteen aoageluLock("sageemethodfshouldneed    whieddoolactuwhiy acquiraegelulock.loOtnge aInput:    (clorred f)sag                bataeeiiled fmsFenage flock m#sag
#
# RefilesedwList - refererelulockfwbject)
ssag

#############################################################sa###
 -     {
Path
    {rSelf#s {};e
        # c"rwteeaehase Fenage fwbject)
}
$sThiss $nam =

    }
$sClorrny ref({sThis)||{sThis;                            g    tegelued f Fenage fclorrh2(    r    elf->{batan$sF}s $nam =unt    r    elf->{locked}=0d)     }
    r    elf->{nRe    rytime}s 0.2;                            # timeis_)wair    betwee#
        ries    }
    r    elf->{nRe    ries} _= 50;                            # tofai nurns:    w m
        ries    }
    r    elf->{ifail($s} nC120;# 3600;                    # ifailu($s    limi     inesealuds    }
    r    elf->{recuN e_level}i= 0th2(    r    elf->{hostID}i= _g    t_site_ID(ath2=) =files        r    elf,$sClorr; me})



#################################################################     impleLock, DESTROYr-    der     uctor. Noteen aoagelulockf th"rleata$#nge aon geluwbject'-lSEif uctper.loOtnge aInput:    nk li(jsworge fclorred f)sagsag
#
# Ren/a t(don'ta whiuge thmethodfexplicitly))
ssag

#############################################################sa###
DESTROY    {
Path
    {rSelf=$nam =unt    r    elf->Unlock; me})



################################################################## _    ry_ran$sFr-    Trydoolg    tegelulockrby ran$s sos'batan$sF'.OPNroolsag    'batan$sF'.LCK.<HOST>.<PID>. Nor publichmethod.sag        sag    Input:    batan$sFsagsag
#
# Ref uwi fiela;
 d wireed f  asesuwritsful, o                wi@Refa    }} mssag

#############################################################sa###
_    ry_ran$sF    {
Path
    {rSelf#s $nam =unt}
$sHostID Bn
r    elf->{hostID}d) =) = @_$fn#s $nam =unt;

ran$sF("$fn.OPN","$fn.LCK.$sHostID")) mem{;

        }
    1;e
        # reed f  asesuwritsfulfitr} me        }e mem{;

        }
    0;e
        #  asenotpsuwritsfulfitr} me})



################################################################## _    ry_ran$sF_bick'-    Trydool"rleataegelulockrby ran$s sos'batan$sF'.LCK.PIDlsag    ool'batan$sF'.OPN. Nor publichmethod.sag        sag    Input:    batan$sFsagsag
#
# Ref uwi fiela;
 d wireed f  asesuwritsful, o                wi@Refa    }} mssag

#############################################################sa###
_    ry_ran$sF_bickme
Path
    {rSelf#s $nam =unt}
$sHostID Bn
r    elf->{hostID}d) = @_$fn#s $nam =unt;

ran$sF("$fn.LCK.$sHostID","$fn.OPN"))
        # reed f  asesuwritsfulfitr{;

        }
    1;fitr} me        }e mem{;

        }
    0;e
            #  asenotpsuwritsfulfitr} me})



################################################################### _                nup -eTrydooldeleteeaotelockeiilthassociateddoold wigive#UC#    batan$sF.sag        sag    Input:    batan$sFsagsag
#
# Re        impleLock, 2)###
,sag                        impleLock, ERR_DIRPERM
,a;
 d widirectoru#caemeteeedLiad mssag

#############################################################sa###
_                nupme
Path
    {fns $nam =unt;

raf({fn))se                                            G    tegelubatan$sFa;
     nmkbject
List - re.saCmr})
$fn->{locked}i= 0th2(
$fn#s $fn->{batan$sF};fitr} me
    {bn Bn    {_Batan$sF::batan$sF({fn)d) = @_@pids;
    {nless= 0th2(;

!nlesdir DH,n    {_Batan$sF::dirn$sF({fn)) mem{;

        }
    $ERR_DIRPERM
;
        # re    }
    :  0 a;
         #caemete"rw"age fdirectorufitr} memTRle ($_="rw"dir DH)loCmr})
;
 ($_deq "{bn.OPN")e                                # teluwlesslock mem    S)
        unlink "$fn.LCK.OPN";                            # deleteetelueiiluus sosfuotepafisaCmt}##
            }
 (/{bn\.LCK\.(\S*)\.(-?\d+)$/)                # aec
    {
dulockrFenahost $1 pid $2 mem    S)
        unlink "$fn.LCK.$1.$2";                            # deleteetelueiiluus sosfuotepafisaCmt}##
    }##
    c
    {
dir DH;;

        }
    $2)###
; me})



#################################################################### _ini     -wIni    ializaegelulockrby c"rwtthe ane.OPNrflag.    C liuge t### e surFenalocksre
 - ly c"rwtedeeiils. T    sums    l shsomeisime Er### delayaon gelufirsta whiuw mLock(".sag        sag    Input:    batan$sFsagsag
#
# Re        impleLock, 2)###
,sag                        impleLock, ERR_DIRPERM
,aon eiiluc"rwtter probilms. mssag

#############################################################sa###
_ini    me
Path
    {rSelf#s $nam =unt}
$sFn Bn
r    elf->{batan$sF};fitunlles    (wles(TF, '>'.
r    elf->{batan$sF}.'.OPN'))            trydoolc"rwteetelueiil mem{;

        }
    $ERR_DIRPERM
;##
    }##
c
    {
(TF);e
        # c
    {
ei    me
        }
    $2)###
; me})



##################################################################### _do_lockr-    (Trydoo)lg    tegelulock.eD n'ta whiuge thdirectly ### acter Ersid er    #ipick($s. T    sum thaiprivwteemethod.sag        sag    Input:    nk li(excepthe emkbject
List - re)sagsag
#
# Re        impleLock, 2)###
,sag                        impleLock, ERR_DIRPERM
,        on eiiluc"rwtter probilms. ms                        impleLock, ERR_TIMEOUT,        time Errer acquirthe shlulock m#e                    impleLock, ERR_NOOPNNOLCK,    nkelockeiilth(unini    ializadiifate) m#e                    impleLock, ERR_STALELCK,        a ifailulockeiiluhasefe nongee                    impleLock, ERR_MORELCK,        ssse c
    {
dulockeiils mssag

#############################################################sa###
_do_lockme
Path
    {rSelf#s $nam =unt}
$fn Bn
r    elf->{batan$sF};fit}
$nRe    ries Bn
r    elf->{nRe    ries};fit}
$nRe    rytime Bn
r    elf->{nRe    rytime};fit}
$    ry;fitfin(t    ry=0;
$    ry<$nRe    ries;
$    ry++)loCmr})
 @_$mewr=isime;last;                        let's chang er    #imtime o
 d wiwlesslock memutime($mew,$mew,"$fn.OPN");                    # (t    sum thneededdFenage fdetectter o
 ifailulock() mem        {
        Trydooldo d wireed f mem        {
;
 ($r    elf->_    ry_ran$sF({fn)) mem    {
            $r    elf->{locked}=1;                            # OK,         #hll wshlulock m

        }
    $2)###
; mercng
)            }} mem    {
            #)
        # Unsuwritsfulireed f. Wair    ferInumTRle anotgoy  gain
            #)
        s    lectV(ASSER,ASSER,ASSER,$nRe    rytime);fitrc}##    t}h2em        {
        St                nkesuwrits af parse loaiugries.#ChrckrFenapossibilireatonh2em        {
h2em        {
        ChrckrFenadirectoru#ppamss pers mem###        }
$rn Bnint(rano(10000));;
    }
$    emped f#=    "$fn.TEMP.$$.
rn"efitrunlles    ( wles(TF, ">$    emped f.OPN") &&
        # c"rwteeae    empueiil mem
c
    {
(TF) &&

        # c
    {
ei    me
                $r    elf->_    ry_ran$sF({    emped f) &&
# reed f ir    as!!        ioaw# if    ruwlesslock mem            $r    elf->_    ry_ran$sF_bick({    emped f) &&    # reed f ir    bickme

        unlink("$    emped f.OPN") )                    # delete mem    S)

        }
    $ERR_DIRPERM
;
        # i        ed bo
 d w@Refails re    }
    :  0 fitrc}##    t
    {bn Bn    {_Batan$sF::batan$sF({fn)d) == @_@pids;
    {bOless= 0th2((;

!nlesdir DH,n    {_Batan$sF::dirn$sF({fn)) mem    S)

        }
    $ERR_DIRPERM
;
        # re    }
    :  0 a;
         #caemete"rw"age fdirectorufitrc}##       }
$fn$sFth2((mTRle ($fed f#=    "rw"dir DH)loCm    {)
        ;
 ($fed f#eq "{bn.OPN")e                        # teluwlesslock mem    re
                    bOless= 1;
            )}
                    };

fed f#=~ /{bn\.LCK\.(\S+)\.(-?\d+)$/)# aec
    {
dulockrFenahost $1 pid $2 mem    re
                puse @pids, "$1.$2";
            )}
            ng
    c
    {
dir DH;;
        {
;
 ($bOles) e
        # .OPNrpresd a##m    re
                ;
 (s whar @pids)e                        # (at             stmk liinifa refof) .LCK.<HOST>.<PID>  thpresd a##m    rre{

        }
    $ERR_OPNANDLCK;                    # probilm:ulockf th!n    invalidiifate;
        ));
            )        }}e
        # nke.LCK.<HOST>.<PID>##m    rre{

        }
    $ERR_TIMEOUT;                        # teoughulockf thwlessmewret  asea time Er    ;
        ));
            }##
            }e    else                                # .OPNr! Tnotppresd a##m    re
                ;
 (s whar @pidsn=BS1)                        # exactly k li.LCK.<HOST>.<PID>  thpresd a##m    rre{
                    #;
        ))# Te thmeansen aoagelulockf th!n    aw(sanF)eoccupiediifate;
        ))#
                    }
$lockn#=    "$fn.LCK.".$pids[0];?
            e mem    rr}
$($s    =w(sfat($lockn))[9];?
            e @_$mewr=isime;;
        ));
 ($mew-$($s    >     r    elf->{ifail($s})            sela;
 d wilockf thwlder oh    nmd wiifailulimi    ##tName
e

        }
    $ERR_STALELCK;    {
        ));
            )            }} mem    rr
e

        }
    $ERR_TIMEOUT;?
            e
};
        ));
            )        };
 (s whar @pids)e                        # ssse .LCK.<HOST>.<PID> l        #presd a##m    rre{

        }
    $ERR_MORELCK;;
        ));
            )        }}e
            # .LCK.<HOST>.<PID>  thnotppresd a##m    rre{
                    #;
        ))# Unini    ializadiifate
                    #;
        ))
        }
    $ERR_NOOPNNOLCK;;
        ));
            }##
}h2=) #

##################################################################### Lockr-    PublichmethodrFenag    ttthe shlulock. sag        sag    Input:    nk li(excepthe emkbject
List - re)sagsag
#
# Re        impleLock, 2)###
,sag                        impleLock, ERR_TIMEOUT,        time Errer acquirthe shlulock m#e                    impleLock, ERR_DIRPERM
,        on eiiluc"rwtter probilms m#e                    impleLock, FAILURE,        sfailu ifo                  nup/ini    ializwtter m#e            (        impleLock, RECURSE,        sintertahwrecuN per detecteo)messag

#############################################################sageNoteen aoage th     lls itself#recuN pvely k m
        riessctertaketh      ifnotpool"ur away.sa###
Lockme
Path
    {rSelf=$nam =unt;

++    r    elf->{recuN e_level}i>= 5)e                        # cceck    n aoawe l        #notploopthe !n "rcuN e mem{;

        }
    $ERR_RECURSE;;
    #
        }
    $ERR_FAILURE;g
            }
;
 ($r    elf->{locked})loCmr})
$r    elf->{recuN e_level}--;;

        }
    ($2)###
);fitr} me
    {re     Bn
r    elf->_do_lock();    }
;
 ($re     Bs         )###
R mem{h2em        {
        Suwritsfully gotegelulock.loem        {
$r    elf->{recuN e_level}--;;

        }
    $2)###
;e
            # suwritsfully gotegelulockfitr} me        };
 ($re     Bs     ERR_TIMEOUTR mem{h2em        {
        A time Errhaseoccureo.loem        {
$r    elf->{recuN e_level}--;;

        }
    $ERR_TIMEOUT
            #      #hldea time Erfitr} me        };
 ($re     Bs     ERR_STALELCKR mem{h2em        {
        A ifailulockrhasebee# detecteo.

        nup anotgoy  gain.loem        {
_                nup(
r    elf->{batan$sF});;
    }
$re     Bn
r    elf->Lock();    }
$r    elf->{recuN e_level}--;;

        }
    ($
        ==        )###
R?        )###
:$FAILURE;g
            }
        };
 ($re     Bs     ERR_DIRPERM
R mem{h2em        {
        A (possibil) probilmdrifiedirectoru#ppamss pers mem###
        }
    $ERR_DIRPERM
;##
    }##
        };
 ($re     Bs     ERR_NOOPNNOLCKR mem{h2em        {
        Unini    ializad.wIni    ializaegelulockriruwlessifate
        #fitrunlles    ( wles(TF, '>'.
r    elf->{batan$sF}.'.OPN') &&    # c"rwteeueiil mem
c
    {
(TF) )e
        # c
    {
ei    me
m    {
            $r    elf->{recuN e_level}--;;

        }
    $ERR_DIRPERM
;##
    );
        s    lect(ASSER,ASSER,ASSER,.5);e                                    wair    numTRle;
    }
$re     Bn
r    elf->Lock();e                                # trydoolg    tei    me
m$r    elf->{recuN e_level}--;;

        }
    ($
        ==        )###
R?        )###
:$FAILURE;
        # re    }
    suwrits ;
 OK##
    }##
        };
 ($re     Bs     ERR_OPNANDLCK || $re     Bs     ERR_MORELCK)        Invalidiifatusnge    r})
_                nup(
r    elf->{batan$sF});
        # remove e loyulockeiils m        # ini    ializaegelulockriruwlessifate
        unlles    ( wles(TF,
r    elf->{batan$sF}.'.OPN') &&        # c"rwteeteluwlesslockueiil mem
c
    {
(TF) )e
        # me
m    {
            $r    elf->{recuN e_level}--;;

        }
    $ERR_DIRPERM
;##
    );
        s    lect(ASSER,ASSER,ASSER,.5);e                                    wair    numTRle;
    }
$re     Bn
r    elf->Lock();e                                # trydoolg    tegelulockfitr$r    elf->{recuN e_level}--;;

        }
    ($
        ==        )###
R?        )###
:$FAILURE;
        # re    }
    suwrits ;
 OK##
    }##
}h2=) #

###################################################################### Unlockr-    Rrleataegelulock m#e    sag    Input:    nk li(excepthe emkbject
List - re)sagsag
#
# Re        impleLock, 2)###
,         impleLock, FAILURE mssag

#############################################################sa###
Unlockme
Path
    {rSelf=$nam =unt;

$r    elf->{locked})loCmr})
}
$fn Bn
r    elf->{batan$sF};fit    unlles    ($r    elf->_    ry_ran$sF_bick({r    elf->{batan$sF})) mem    S)

        }
    $FAILURE;g
    );
            r    elf->{locked}=0d)         );

        }
    $2)###
; me})



####################################################################### _g    t_prorits_IDr-    G    te    nmIDruniquf Fenage fcur - othrorits anothost.sag        sag    Input:    nk lsagsag
#
# Rehost specifichID mssag

#############################################################sa###
_g    t_site_IDme
Path;

 SERis r(        impleLock, s_sHosted f)g
    )&& (        impleLock, s_sHosted f  li'')) mem{;

        }
    $    impleLock, s_sHosted f.'.'.
$;fitr} me
    {sLocalhost Bn    {
        $ACGetHosted f();    }
;
 (     rSERis r $sLocalhostR ng N&& (    sLocalhost  li'')) mem{;
            impleLock, s_sHosted f = $sLocalhost;        # sll wshluhosted f#asea 'ifatic'rFenala parusigeacc
        }
 "$sLocalhost.
$";e                            atawshluhosted f#i        evailabilfitr} me
    {sRanoom#=    "RND".int(rano(1000));                    atawa ranoom#if the o                wi@R    }
        }
 "{sRanoom.
$";##
}h2=)


################################################################# LockrFuncttersr-    end mssag

#############################################################sa######################################################################
ick($s        {_Batan$sFr-    p
#0  eiiluspecificwtters###sageCodluhasetakeruw lo actershluFRle::Batan$sFrifa de stPerl moduil### doolavoidifur        # dmoduil
Liquiraid as mssag

#############################################################sa
ick($s        {_Batan$sFd)     }#ataw        #'taint'd)     }rCe!v
#0 qw($VERS
ON $FRlep
#0 _fstype $FRlep
#0 _ign     0 );    }$VERS
ON =    "2.6"d)     }# eueiilp
#0 _s    t_fstype() #    specify OS-bata$#ruilthuta$#irufu    }
fUC# aaaaaaaaaaaaaaaaaaaaaaaaaaa     lls ool" Eris srentge th
ick($smessagee#Cur - oiy "rcognizadi fiel ReVM
,aMSDO
,aMacO
,aAmigaO
,aos2, RISCOSUC# aaaaaaAd bo        # dn$sFrutas    Unix-styil
Luilthanotith     0 -tansitpveh2sa###
eiilp
#0 _s    t_fstype {;
  }
@old    =w($FRlep
#0 _fstype, $FRlep
#0 _ign     0 );    } #i        (@_) {;
    $FRlep
#0 _fstype = $_[0];?
    $FRlep
#0 _ign     0     =w($_[0]#=~ /^(?:MacO
|VM
|AmigaO
|os2|RISCOS|MSWin32|MSDO
)/i);    } #}    } #wantarray ?
@old    Re    old[0];?
})     }# eueiilp
#0 () #    p
#0  eiiluspecificwttermessagee#V N per 2.4  27-Sep-1996e#CharilthBailey  [e-mail]#######
eiilp
#0  {;
  }
($fulln$sF,@sufficesassword)   }
($fstype,$ign     0 )    =w($FRlep
#0 _fstype, $FRlep
#0 _ign     0 );    } #}
($dirpafi,$e\"l,$suffix,$batan$sF);    } #}
($taint)    =w###if ($fulln$sF,0,0);          Is $fulln$sF tainted?#### #i        ($fstype =~ /^VM
/i) {;
    i        ($fulln$sF =~ m#/#) {
$fstype = '' }          We'reemothe Unix emulaeterme            }} {;
         r$dirpafi,$batan$sF)    =w($fulln$sF =~ /^(.*[:>\]])?(.*)/);;
         $dirpafi ||=    '';          shouldnalwayshbe SERis r;
    }    } #}    } #i        ($fstype =~ /^MS(DO
|Win32)/i) {;
    r$dirpafi,$batan$sF)    =w($fulln$sF =~ /^((?:.*[:\\\/])?)(.*)/);;
    $dirpafi .=    '.\\' unlles    $dirpafi =~ /[\\\/]$/;    } #}    } #        };

fstype =~ /^MacO
/i) {;
    r$dirpafi,$batan$sF)    =w($fulln$sF =~ /^(.*:)?(.*)/);;
  }    } #        };

fstype =~ /^AmigaO
/i) {;
    r$dirpafi,$batan$sF)    =w($fulln$sF =~ /(.*[:\/])?(.*)/);;
    $dirpafi =    './' unlles    $dirpafi;;
  }    } #        };

fstype !~ /^VM
/i) {          de our  oolUnix;
    r$dirpafi,$batan$sF)    =w($fulln$sF =~ m#^(.*/)?(.*)#);;
    ;

^Odeq 'VM
'hanot$fulln$sF =~ m:/[^/]+/000000/?:) {;
                 dev:[000000]tithtopbo
 VM
 tree, simihar oolUnix '/';
         r$batan$sF,$dirpafi)    =w('',$fulln$sF);;
    };
    $dirpafi =    './' unlles    $dirpafi;;
  }    }    } #i        (@sufficesas{;
    $e\"l    =    '';;
    Feneach $suffix    (@sufficesas{;
      }
$paf    =w($ign     0     ? '(?i)'    Re'') . "($suffix)\$";##      ;
 ($batan$sFrB~ s/$paf//as{;
        $e\"n     .Bn###if ($suffix,0,0);;
        $e\"l    =    $1#. $e\"l;;
      };
    }    } #}    }    } #$e\"l    .Bn
e\"n     ;
 SERis r $e\"l;            avoidiwl    nthe ;
 $e\"l    == ASSER    } #wantarray ?
($batan$sFr.n
e\"n    , $dirpafi .n
e\"n    , $e\"l);
         aaa: $batan$sFr.n
e\"n    ;?
})     }sagee#batan$sF() -wLi#
# afirstaelim< aso
 listwLi#
#id by eiilp
#0 ()#######
batan$sFr{;
  }
($n$sF)    =w$nam =un     reiilp
#0 ($n$sF, map("\Q$_\E",@_)))[0];?
})     }sagee#dirn$sF() -wLi#
# adevicF anotdirectoru#portter o
 eiiluspecificwttermes     aaaBehavienamatchesen aoao
 Unix dirn$sF(1) exactly f0 tUnix anotMSDO
mes     aaaeiilspecs excepthf0 tn$sFsm< $the rifiea slp
#atin$Se.g., "/xx/yy/".mes     aaaTe thdiff N  actershlusealudaelim< aso
 gelulistwLi#
#idmes     aaaby eiilp
#0 ()rentgeaoagelutr\"l sos'/' (Unix)rer '\' (MSDO
) (andmes     aaagelul    stmdirectoru#ed f#i        telueiilspecm< $th!n    aw'/' er '\'),tithlost.sa#####
dirn$sFs{;
    }
($batan$sF,$dirn$sF)    =weiilp
#0 ($_[0]);;
    }
($fstype)    =w$FRlep
#0 _fstype;    }    } # #i        ($fstype =~ /VM
/i) { ;
        ;
 ($_[0]#=~ m#/#) {
$fstype = '' };
                }} { re    }
    $dirn$sF || $ENV{DEFAULT} };
    }    } # #i        ($fstype =~ /MacO
/i) { re    }
    $dirn$sF }me            }i        ($fstype =~ /MSDO
/i) { ;
        $dirn$sF B~ s/([^:])[\\\/]*$/$1/;;
        unlles( length($batan$sF)    as{;
           r$batan$sF,$dirn$sF)    =weiilp
#0  $dirn$sF;;
           $dirn$sF B~ s/([^:])[\\\/]*$/$1/;;
    };
    }    } # #        }i        ($fstype =~ /MSWin32/i) { ;
        $dirn$sF B~ s/([^:])[\\\/]*$/$1/;;
        unlles( length($batan$sF)    as{;
           r$batan$sF,$dirn$sF)    =weiilp
#0  $dirn$sF;;
           $dirn$sF B~ s/([^:])[\\\/]*$/$1/;;
    };
    }    } # #        }i        ($fstype =~ /AmigaO
/i) {;
     # #i        (    $dirn$sF B~ /:$/) { re    }
    $dirn$sF }me    aaaa hopb$dirn$sF;;
        $dirn$sF B~ s#[^:/]+$## unlles    length($batan$sF);;
    }    } # #        }e { ;
        $dirn$sF B~ s:(.)/*$:$1:;;
        unlles( length($batan$sF)    as{;
           local($    {_Batan$sF::FRlep
#0 _fstype)    =w$fstype;    }           r$batan$sF,$dirn$sF)    =weiilp
#0  $dirn$sF;;
           $dirn$sF B~ s:(.)/*$:$1:;;
    };
    }    };
    $dirn$sF;;
}    };
eiilp
#0 _s    t_fstype
^O;)


#################################################################     {_Batan$sFrclorrr-    end mssag

#############################################################sa